!---------------------------------------------------------------------------------------------------- !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Sharan Roongta, Max-Planck-Institut für Eisenforschung GmbH !> @brief Parser for YAML files. !> @details Module converts a YAML input file to an equivalent YAML flow style which is then parsed. !---------------------------------------------------------------------------------------------------- module YAML use prec use misc use IO use types #ifdef FYAML use system_routines #endif implicit none(type,external) private public :: & YAML_init, & YAML_str_asList, & YAML_str_asDict #ifdef FYAML interface subroutine to_flow_C(flow,length_flow,mixed) bind(C) use, intrinsic :: ISO_C_Binding, only: C_LONG, C_CHAR, C_PTR implicit none(type,external) type(C_PTR), intent(out) :: flow integer(C_LONG), intent(out) :: length_flow character(kind=C_CHAR), dimension(*), intent(in) :: mixed end subroutine to_flow_C end interface #endif contains !-------------------------------------------------------------------------------------------------- !> @brief Do sanity checks. !-------------------------------------------------------------------------------------------------- subroutine YAML_init() print'(/,1x,a)', '<<<+- YAML init -+>>>' #ifdef FYAML print'(/,1x,a)', 'libfyaml powered' #else call YAML_selfTest() #endif end subroutine YAML_init !-------------------------------------------------------------------------------------------------- !> @brief Parse a YAML string with list at root into a structure of nodes. !> @details The string needs to end with a newline (unless using libfyaml). !-------------------------------------------------------------------------------------------------- function YAML_str_asList(str) result(list) character(len=*), intent(in) :: str type(tList), pointer :: list class(tNode), pointer :: node node => parse_flow(to_flow(str)) list => node%asList() end function YAML_str_asList !-------------------------------------------------------------------------------------------------- !> @brief Parse a YAML string with dict at root into a structure of nodes. !> @details The string needs to end with a newline (unless using libfyaml). !-------------------------------------------------------------------------------------------------- function YAML_str_asDict(str) result(dict) character(len=*), intent(in) :: str type(tDict), pointer :: dict class(tNode), pointer :: node node => parse_flow(to_flow(str)) dict => node%asDict() end function YAML_str_asDict !-------------------------------------------------------------------------------------------------- !> @brief Read a string in flow style and store it in the form of dictionaries, lists, and scalars. !> @details A node-type pointer can either point to a dictionary, list, or scalar type entities. !-------------------------------------------------------------------------------------------------- recursive function parse_flow(YAML_flow) result(node) character(len=*), intent(in) :: YAML_flow !< YAML file in flow style class(tNode), pointer :: node class(tNode), pointer :: & myVal character(len=:), allocatable :: & flow_string, & key integer(pI64) :: & e, & ! end position of dictionary or list s, & ! start position of dictionary or list d ! position of key: value separator (':') flow_string = trim(adjustl(YAML_flow)) if (len_trim(flow_string,pI64) == 0_pI64) then node => emptyDict return elseif (flow_string(1:1) == '{') then ! start of a dictionary e = 1_pI64 allocate(tDict::node) do while (e < len_trim(flow_string,pI64)) s = e d = s + scan(flow_string(s+1_pI64:),':',kind=pI64) e = d + find_end(flow_string(d+1_pI64:),'}') key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64))) if (quotedStr(key)) key = key(2:len(key)-1) myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tDict) call node%set(key,myVal) end select end do elseif (flow_string(1:1) == '[') then ! start of a list e = 1_pI64 allocate(tList::node) do while (e < len_trim(flow_string,pI64)) s = e e = s + find_end(flow_string(s+1_pI64:),']') myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tList) call node%append(myVal) end select end do else ! scalar value allocate(tScalar::node) select type (node) class is (tScalar) if (quotedStr(flow_string)) then node = trim(adjustl(flow_string(2:len(flow_string)-1))) else node = trim(adjustl(flow_string)) end if end select end if end function parse_flow !-------------------------------------------------------------------------------------------------- !> @brief Find location of chunk end: ',' '}', or ']'. !> @details leaves nested lists ( '[...]' and dicts '{...}') intact !-------------------------------------------------------------------------------------------------- integer(pI64) function find_end(str,e_char) character(len=*), intent(in) :: str !< chunk of YAML flow string character, intent(in) :: e_char !< end of list/dict ( '}' or ']') integer(pI64) :: N_sq, & !< number of open square brackets N_cu, & !< number of open curly brackets i N_sq = 0_pI64 N_cu = 0_pI64 i = 1_pI64 do while(i<=len_trim(str,pI64)) if (scan(str(i:i),IO_QUOTES,kind=pI64) == 1_pI64) i = i + scan(str(i+1:),str(i:i),kind=pI64) if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',',kind=pI64) == 1_pI64) exit N_sq = N_sq + merge(1_pI64,0_pI64,str(i:i) == '[') N_cu = N_cu + merge(1_pI64,0_pI64,str(i:i) == '{') N_sq = N_sq - merge(1_pI64,0_pI64,str(i:i) == ']') N_cu = N_cu - merge(1_pI64,0_pI64,str(i:i) == '}') i = i + 1_pI64 end do find_end = i end function find_end !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string is enclosed with single or double quotes. !-------------------------------------------------------------------------------------------------- logical function quotedStr(line) character(len=*), intent(in) :: line quotedStr = .false. if (len(line) == 0) return if (scan(line(:1),IO_QUOTES) == 1) then quotedStr = .true. if (line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line) end if end function quotedStr #ifdef FYAML !-------------------------------------------------------------------------------------------------- ! @brief Convert all block-style YAML parts to flow style. !-------------------------------------------------------------------------------------------------- function to_flow(mixed) result(flow) character(len=*), intent(in) :: mixed character(:,C_CHAR), allocatable :: flow type(C_PTR) :: str_ptr integer(C_LONG) :: strlen call to_flow_C(str_ptr,strlen,f_c_string(mixed)) if (strlen < 1_C_LONG) call IO_error(703,ext_msg='libyfaml') allocate(character(len=strlen,kind=c_char) :: flow) block character(len=strlen,kind=c_char), pointer :: s call c_f_pointer(str_ptr,s) flow = s(:len(s,pI64)-1_pI64) end block call free_C(str_ptr) end function to_flow #else !-------------------------------------------------------------------------------------------------- ! @brief Determine indentation depth. ! @details Indentation level is determined for a given block/line. ! In case of nested lists, an offset is added to determine the indent of the item block (skip ! leading dashes). !-------------------------------------------------------------------------------------------------- integer function indentDepth(line,offset) character(len=*), intent(in) :: line integer, optional,intent(in) :: offset indentDepth = verify(line,IO_WHITESPACE) - 1 + misc_optional(offset,0) end function indentDepth !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string is in flow style, i.e. starts with '{' or '['. !-------------------------------------------------------------------------------------------------- logical function isFlow(line) character(len=*), intent(in) :: line isFlow = index(adjustl(line),'[') == 1 .or. index(adjustl(line),'{') == 1 end function isFlow !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string is a scalar item, i.e. starts without any special symbols. !-------------------------------------------------------------------------------------------------- logical function isScalar(line) character(len=*), intent(in) :: line isScalar = (.not. isKeyValue(line) .and. & .not. isKey(line) .and. & .not. isListItem(line) .and. & .not. isFlow(line)) end function isScalar !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string is a list item, i.e. starts with '-'. !-------------------------------------------------------------------------------------------------- logical function isListItem(line) character(len=*), intent(in) :: line isListItem = .false. if (len_trim(adjustl(line))> 2 .and. index(trim(adjustl(line)), '-') == 1) then isListItem = scan(trim(adjustl(line)),' ') == 2 else isListItem = trim(adjustl(line)) == '-' end if end function isListItem !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string contains a key-value pair of the form ': '. !-------------------------------------------------------------------------------------------------- logical function isKeyValue(line) character(len=*), intent(in) :: line isKeyValue = .false. if ( .not. isKey(line) .and. index(clean(line),':') > 0 .and. .not. isFlow(line)) then if (index(clean(line),': ') > 0) isKeyValue = .true. end if end function isKeyValue !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string contains a key without a value, i.e. it ends in ':'. ! ToDo: check whether this is safe for trailing spaces followed by a newline character !-------------------------------------------------------------------------------------------------- logical function isKey(line) character(len=*), intent(in) :: line if (len(clean(line)) == 0) then isKey = .false. else isKey = index(clean(line),':',back=.false.) == len(clean(line)) .and. & index(clean(line),':',back=.true.) == len(clean(line)) .and. & .not. isFlow(line) end if end function isKey !-------------------------------------------------------------------------------------------------- ! @brief Check whether a string is a list in flow style. !-------------------------------------------------------------------------------------------------- logical function isFlowList(line) character(len=*), intent(in) :: line isFlowList = index(adjustl(line),'[') == 1 end function isFlowList !-------------------------------------------------------------------------------------------------- ! @brief Skip empty lines. ! @details Update start position in the block by skipping empty lines if present. !-------------------------------------------------------------------------------------------------- subroutine skip_empty_lines(blck,s_blck) character(len=*), intent(in) :: blck integer, intent(inout) :: s_blck logical :: empty empty = .true. do while (empty .and. len_trim(blck(s_blck:)) /= 0) empty = len_trim(clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0 if (empty) s_blck = s_blck + index(blck(s_blck:),IO_EOL) end do end subroutine skip_empty_lines !-------------------------------------------------------------------------------------------------- ! @brief Skip file header. ! @details Update start position in the block by skipping file header if present. !-------------------------------------------------------------------------------------------------- subroutine skip_file_header(blck,s_blck) character(len=*), intent(in) :: blck integer, intent(inout) :: s_blck character(len=:), allocatable :: line line = clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) if (index(adjustl(line),'%YAML') == 1) then s_blck = s_blck + index(blck(s_blck:),IO_EOL) call skip_empty_lines(blck,s_blck) if (trim(clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == '---') then s_blck = s_blck + index(blck(s_blck:),IO_EOL) else call IO_error(708,ext_msg = line) end if end if end subroutine skip_file_header !-------------------------------------------------------------------------------------------------- !> @brief Check whether a line in flow style starts and ends on the same line. !-------------------------------------------------------------------------------------------------- logical function flow_is_closed(str,e_char) character(len=*), intent(in) :: str character, intent(in) :: e_char !< end of list/dict ( '}' or ']') integer :: N_sq, & !< number of open square brackets N_cu, & !< number of open curly brackets i character(len=:), allocatable:: line flow_is_closed = .false. N_sq = 0 N_cu = 0 if (e_char == ']') line = str(index(str(:),'[')+1:) if (e_char == '}') line = str(index(str(:),'{')+1:) do i = 1, len_trim(line) flow_is_closed = (N_sq==0 .and. N_cu==0 .and. scan(line(i:i),e_char) == 1) N_sq = N_sq + merge(1,0,line(i:i) == '[') N_cu = N_cu + merge(1,0,line(i:i) == '{') N_sq = N_sq - merge(1,0,line(i:i) == ']') N_cu = N_cu - merge(1,0,line(i:i) == '}') end do end function flow_is_closed !-------------------------------------------------------------------------------------------------- !> @brief Return a flow-style line without line break. !-------------------------------------------------------------------------------------------------- subroutine remove_line_break(blck,s_blck,e_char,flow_line) character(len=*), intent(in) :: blck !< YAML in mixed style integer, intent(inout) :: s_blck character, intent(in) :: e_char !< end of list/dict ( '}' or ']') character(len=:), allocatable, intent(out) :: flow_line logical :: line_end line_end = .false. flow_line = '' do while (.not. line_end) flow_line = flow_line//clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))//' ' line_end = flow_is_closed(flow_line,e_char) s_blck = s_blck + index(blck(s_blck:),IO_EOL) end do end subroutine remove_line_break !-------------------------------------------------------------------------------------------------- !> @brief Return a scalar list item without line break. !-------------------------------------------------------------------------------------------------- subroutine list_item_inline(blck,s_blck,inline,offset) character(len=*), intent(in) :: blck !< YAML in mixed style integer, intent(inout) :: s_blck character(len=:), allocatable, intent(out) :: inline integer, intent(inout) :: offset character(len=:), allocatable :: line integer :: indent,indent_next indent = indentDepth(blck(s_blck:),offset) line = clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) inline = line(indent-offset+3:) s_blck = s_blck + index(blck(s_blck:),IO_EOL) indent_next = indentDepth(blck(s_blck:)) do while (indent_next > indent) inline = inline//' '//trim(adjustl(clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)))) s_blck = s_blck + index(blck(s_blck:),IO_EOL) indent_next = indentDepth(blck(s_blck:)) end do if (scan(inline,",") > 0) inline = '"'//inline//'"' end subroutine list_item_inline !-------------------------------------------------------------------------------------------------- ! @brief Read a line of YAML block that is already in flow style. ! @details A dict should be enclosed within '{}' for it to be consistent with the DAMASK YAML parser. !-------------------------------------------------------------------------------------------------- recursive subroutine line_isFlow(flow,s_flow,line) character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_flow !< start position in flow character(len=*), intent(in) :: line integer :: & s, & list_chunk, & dict_chunk if (index(adjustl(line),'[') == 1) then s = index(line,'[') flow(s_flow:s_flow) = '[' s_flow = s_flow+1 do while (s < len_trim(line)) list_chunk = s + find_end(line(s+1:),']') if (iskeyValue(line(s+1:list_chunk-1))) then flow(s_flow:s_flow) = '{' s_flow = s_flow+1 call keyValue_toFlow(flow,s_flow,line(s+1:list_chunk-1)) flow(s_flow:s_flow) = '}' s_flow = s_flow+1 elseif (isFlow(line(s+1:list_chunk-1))) then call line_isFlow(flow,s_flow,line(s+1:list_chunk-1)) else call line_toFlow(flow,s_flow,line(s+1:list_chunk-1)) end if flow(s_flow:s_flow+1) = ', ' s_flow = s_flow+2 s = s + find_end(line(s+1:),']') end do s_flow = s_flow-1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow-1 flow(s_flow:s_flow) = ']' s_flow = s_flow+1 elseif (index(adjustl(line),'{') == 1) then s = index(line,'{') flow(s_flow:s_flow) = '{' s_flow = s_flow+1 do while (s < len_trim(line)) dict_chunk = s + find_end(line(s+1:),'}') if (.not. iskeyValue(line(s+1:dict_chunk-1))) call IO_error(705,ext_msg=line) call keyValue_toFlow(flow,s_flow,line(s+1:dict_chunk-1)) flow(s_flow:s_flow+1) = ', ' s_flow = s_flow+2 s = s + find_end(line(s+1:),'}') end do s_flow = s_flow-1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow-1 flow(s_flow:s_flow) = '}' s_flow = s_flow+1 else call line_toFlow(flow,s_flow,line) end if end subroutine line_isFlow !------------------------------------------------------------------------------------------------- ! @brief Transform a line of YAML of type : to flow style. ! @details Ensures that the is consistent with the input required in the DAMASK YAML parser. !------------------------------------------------------------------------------------------------- recursive subroutine keyValue_toFlow(flow,s_flow,line) character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_flow !< start position in flow character(len=*), intent(in) :: line character(len=:), allocatable :: line_asStandard ! standard form of : integer :: & d_flow, & col_pos, & offset_value col_pos = index(line,':') if (line(col_pos+1:col_pos+1) /= ' ') call IO_error(704,ext_msg=line) if (isFlow(line(col_pos+1:))) then d_flow = len_trim(adjustl(line(:col_pos))) flow(s_flow:s_flow+d_flow+1) = trim(adjustl(line(:col_pos)))//' ' s_flow = s_flow + d_flow+1 call line_isFlow(flow,s_flow,line(col_pos+1:)) else offset_value = indentDepth(line(col_pos+2:)) line_asStandard = line(:col_pos+1)//line(col_pos+2+offset_value:) call line_toFlow(flow,s_flow,line_asStandard) end if end subroutine keyValue_toFlow !------------------------------------------------------------------------------------------------- ! @brief Transform a line of YAML to flow style. !------------------------------------------------------------------------------------------------- subroutine line_toFlow(flow,s_flow,line) character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_flow !< start position in flow character(len=*), intent(in) :: line integer :: & d_flow d_flow = len_trim(adjustl(line)) flow(s_flow:s_flow+d_flow) = trim(adjustl(line)) s_flow = s_flow + d_flow end subroutine line_toFlow !------------------------------------------------------------------------------------------------- ! @brief Transform a block-style list to flow style. ! @details enters the function when encountered with the list indicator '- ' ! reads each scalar list item and separates each other with a ',' ! If list item is non scalar, it stores the offset for that list item block ! Call the 'decide' function if there is an increase in the indentation level or the list item is not a scalar ! decrease in indentation level indicates the end of an indentation block !------------------------------------------------------------------------------------------------- recursive subroutine lst(blck,flow,s_blck,s_flow,offset) character(len=*), intent(in) :: blck !< YAML in mixed style character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_blck, & !< start position in blck s_flow, & !< start position in flow offset !< stores leading '- ' in nested lists character(len=:), allocatable :: line,flow_line,inline integer :: e_blck,indent indent = indentDepth(blck(s_blck:),offset) do while (s_blck <= len_trim(blck)) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then exit elseif (len_trim(line) == 0) then s_blck = e_blck + 2 ! forward to next line cycle elseif (indentDepth(line,offset) > indent) then call decide(blck,flow,s_blck,s_flow,offset) offset = 0 flow(s_flow:s_flow+1) = ', ' s_flow = s_flow + 2 elseif (indentDepth(line,offset) < indent .or. .not. isListItem(line)) then offset = 0 exit ! job done (lower level) else if (trim(adjustl(line)) == '-') then ! list item in next line s_blck = e_blck + 2 call skip_empty_lines(blck,s_blck) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 line = clean(blck(s_blck:e_blck)) if (trim(line) == '---') call IO_error(707,ext_msg=line) if (indentDepth(line) < indent .or. indentDepth(line) == indent) & call IO_error(701,ext_msg=line) if (isScalar(line)) then call line_toFlow(flow,s_flow,line) s_blck = e_blck +2 offset = 0 elseif (isFlow(line)) then if (isFlowList(line)) then call remove_line_break(blck,s_blck,']',flow_line) else call remove_line_break(blck,s_blck,'}',flow_line) end if call line_isFlow(flow,s_flow,flow_line) offset = 0 end if else ! list item in the same line line = line(indentDepth(line)+3:) if (isScalar(line)) then call list_item_inline(blck,s_blck,inline,offset) offset = 0 call line_toFlow(flow,s_flow,inline) elseif (isFlow(line)) then s_blck = s_blck + index(blck(s_blck:),'-') if (isFlowList(line)) then call remove_line_break(blck,s_blck,']',flow_line) else call remove_line_break(blck,s_blck,'}',flow_line) end if call line_isFlow(flow,s_flow,flow_line) offset = 0 else ! non scalar list item offset = offset + indentDepth(blck(s_blck:))+1 ! offset in spaces to be ignored s_blck = s_blck + index(blck(s_blck:e_blck),'-') ! s_blck after '-' symbol end if end if end if if (isScalar(line) .or. isFlow(line)) then flow(s_flow:s_flow+1) = ', ' s_flow = s_flow+2 end if end do s_flow = s_flow-1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow-1 end subroutine lst !-------------------------------------------------------------------------------------------------- ! @brief Transform a block-style dict to flow style. ! @details enters the function when encountered with the dictionary indicator ':' ! parses each line in the block and compares indentation of a line with the preceding line ! upon increase in indentation level -> 'decide' function decides if the line is a list or dict ! decrease in indentation indicates the end of an indentation block !-------------------------------------------------------------------------------------------------- recursive subroutine dct(blck,flow,s_blck,s_flow,offset) character(len=*), intent(in) :: blck !< YAML in mixed style character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_blck, & !< start position in blck s_flow, & !< start position in flow offset character(len=:), allocatable :: line,flow_line integer :: e_blck,indent,col_pos logical :: previous_isKey previous_isKey = .false. indent = indentDepth(blck(s_blck:),offset) do while (s_blck <= len_trim(blck)) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then exit elseif (len_trim(line) == 0) then s_blck = e_blck + 2 ! forward to next line cycle elseif (indentDepth(line,offset) < indent) then if (isScalar(line) .or. isFlow(line) .and. previous_isKey) & call IO_error(701,ext_msg=line) offset = 0 exit ! job done (lower level) elseif (indentDepth(line,offset) > indent .or. isListItem(line)) then offset = 0 call decide(blck,flow,s_blck,s_flow,offset) else if (isScalar(line)) call IO_error(701,ext_msg=line) if (isFlow(line)) call IO_error(702,ext_msg=line) line = line(indentDepth(line)+1:) if (previous_isKey) then flow(s_flow-1:s_flow) = ', ' s_flow = s_flow+1 end if if (isKeyValue(line)) then col_pos = index(line,':') if (isFlow(line(col_pos+1:))) then if (isFlowList(line(col_pos+1:))) then call remove_line_break(blck,s_blck,']',flow_line) else call remove_line_break(blck,s_blck,'}',flow_line) end if call keyValue_toFlow(flow,s_flow,flow_line) else call keyValue_toFlow(flow,s_flow,line) s_blck = e_blck + 2 end if else call line_toFlow(flow,s_flow,line) s_blck = e_blck + 2 end if end if if (isScalar(line) .or. isKeyValue(line)) then flow(s_flow:s_flow) = ',' s_flow = s_flow+1 previous_isKey = .false. else previous_isKey = .true. end if flow(s_flow:s_flow) = ' ' s_flow = s_flow+1 offset = 0 end do s_flow = s_flow-1 if (flow(s_flow-1:s_flow-1) == ',') s_flow = s_flow-1 end subroutine dct !-------------------------------------------------------------------------------------------------- ! @brief Decide whether next block is list or dict. !-------------------------------------------------------------------------------------------------- recursive subroutine decide(blck,flow,s_blck,s_flow,offset) character(len=*), intent(in) :: blck !< YAML in mixed style character(len=*), intent(inout) :: flow !< YAML in flow style only integer, intent(inout) :: s_blck, & !< start position in blck s_flow, & !< start position in flow offset integer :: e_blck character(len=:), allocatable :: line,flow_line if (s_blck <= len(blck)) then call skip_empty_lines(blck,s_blck) e_blck = s_blck + index(blck(s_blck:),IO_EOL) - 2 line = clean(blck(s_blck:e_blck)) if (trim(line) == '---' .or. trim(line) == '...') then continue ! end parsing at this point but not stop the simulation elseif (len_trim(line) == 0) then s_blck = e_blck + 2 call decide(blck,flow,s_blck,s_flow,offset) elseif (isListItem(line)) then flow(s_flow:s_flow) = '[' s_flow = s_flow+1 call lst(blck,flow,s_blck,s_flow,offset) flow(s_flow:s_flow) = ']' s_flow = s_flow+1 elseif (isKey(line) .or. isKeyValue(line)) then flow(s_flow:s_flow) = '{' s_flow = s_flow+1 call dct(blck,flow,s_blck,s_flow,offset) flow(s_flow:s_flow) = '}' s_flow = s_flow+1 elseif (isFlow(line)) then if (isFlowList(line)) then call remove_line_break(blck,s_blck,']',flow_line) else call remove_line_break(blck,s_blck,'}',flow_line) end if call line_isFlow(flow,s_flow,line) else line = line(indentDepth(line)+1:) call line_toFlow(flow,s_flow,line) s_blck = e_blck + 2 end if end if end subroutine decide !-------------------------------------------------------------------------------------------------- !> @brief Convert all block-style parts to flow style. !> @details The input needs to end with a newline. !-------------------------------------------------------------------------------------------------- function to_flow(blck) character(len=:), allocatable :: to_flow character(len=*), intent(in) :: blck !< YAML mixed style character(len=:), allocatable :: line integer :: s_blck, & !< start position in blck s_flow, & !< start position in flow offset, & !< counts leading '- ' in nested lists end_line allocate(character(len=len(blck)*2)::to_flow) s_flow = 1 s_blck = 1 offset = 0 if (len_trim(blck) /= 0) then call skip_empty_lines(blck,s_blck) call skip_file_header(blck,s_blck) line = clean(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) if (trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL) call decide(blck,to_flow,s_blck,s_flow,offset) end if line = clean(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2)) if (trim(line)== '---') call IO_warning(709,ext_msg=line) to_flow = trim(to_flow(:s_flow-1)) end_line = index(to_flow,IO_EOL) if (end_line > 0) to_flow = to_flow(:end_line-1) end function to_flow !-------------------------------------------------------------------------------------------------- ! @brief Remove comments (characters beyond '#') and trailing space. !-------------------------------------------------------------------------------------------------- function clean(line) character(len=*), intent(in) :: line character(len=:), allocatable :: clean integer :: split character, parameter :: COMMENT_CHAR = '#' split = index(line,COMMENT_CHAR) if (split == 0) then clean = trim(line) else clean = trim(line(:split-1)) end if end function clean !-------------------------------------------------------------------------------------------------- !> @brief Check correctness of some YAML functions. !-------------------------------------------------------------------------------------------------- subroutine YAML_selfTest() if (indentDepth(' a') /= 1) error stop 'indentDepth' if (indentDepth('a') /= 0) error stop 'indentDepth' if (indentDepth('x ') /= 0) error stop 'indentDepth' if (.not. quotedStr("'a'")) error stop 'quotedStr' if ( isFlow(' a')) error stop 'isFLow' if (.not. isFlow('{')) error stop 'isFlow' if (.not. isFlow(' [')) error stop 'isFlow' if ( isListItem(' a')) error stop 'isListItem' if ( isListItem(' -b')) error stop 'isListItem' if (.not. isListItem('- a ')) error stop 'isListItem' if (.not. isListItem('- -a ')) error stop 'isListItem' if ( isKeyValue(' a')) error stop 'isKeyValue' if ( isKeyValue(' a: ')) error stop 'isKeyValue' if (.not. isKeyValue(' a: b')) error stop 'isKeyValue' if ( isKey(' a')) error stop 'isKey' if ( isKey('{a:b}')) error stop 'isKey' if ( isKey(' a:b')) error stop 'isKey' if (.not. isKey(' a: ')) error stop 'isKey' if (.not. isKey(' a:')) error stop 'isKey' if (.not. isKey(' a: #')) error stop 'isKey' if ( isScalar('a: ')) error stop 'isScalar' if ( isScalar('a: b')) error stop 'isScalar' if ( isScalar('{a:b}')) error stop 'isScalar' if ( isScalar('- a:')) error stop 'isScalar' if (.not. isScalar(' a')) error stop 'isScalar' basic_list: block character(len=*), parameter :: block_list = & " - Casablanca"//IO_EOL//& " - North by Northwest"//IO_EOL character(len=*), parameter :: block_list_newline = & " -"//IO_EOL//& " Casablanca"//IO_EOL//& " -"//IO_EOL//& " North by Northwest"//IO_EOL character(len=*), parameter :: flow_list = & "[Casablanca, North by Northwest]" if (.not. to_flow(block_list) == flow_list) error stop 'to_flow' if (.not. to_flow(block_list_newline) == flow_list) error stop 'to_flow' end block basic_list basic_dict: block character(len=*), parameter :: block_dict = & " aa: Casablanca"//IO_EOL//& " bb: North by Northwest"//IO_EOL character(len=*), parameter :: block_dict_newline = & " aa:"//IO_EOL//& " Casablanca"//IO_EOL//& " bb:"//IO_EOL//& " North by Northwest"//IO_EOL character(len=*), parameter :: flow_dict = & "{aa: Casablanca, bb: North by Northwest}" if (.not. to_flow(block_dict) == flow_dict) error stop 'to_flow' if (.not. to_flow(block_dict_newline) == flow_dict) error stop 'to_flow' end block basic_dict only_flow: block character(len=*), parameter :: flow_dict = & " {a: [b,c: {d: e}, f: g, e]}"//IO_EOL character(len=*), parameter :: flow_list = & " [a,b: c, d,e: {f: g}]"//IO_EOL character(len=*), parameter :: flow_1 = & "{a: [b, {c: {d: e}}, {f: g}, e]}" character(len=*), parameter :: flow_2 = & "[a, {b: c}, d, {e: {f: g}}]" if (.not. to_flow(flow_dict) == flow_1) error stop 'to_flow' if (.not. to_flow(flow_list) == flow_2) error stop 'to_flow' end block only_flow basic_flow: block character(len=*), parameter :: flow_braces = & " source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]"//IO_EOL character(len=*), parameter :: flow_mixed_braces = & " source: [param: 1, {param: 2}, param: 3, {param: 4}]"//IO_EOL character(len=*), parameter :: flow = & "{source: [{param: 1}, {param: 2}, {param: 3}, {param: 4}]}" if (.not. to_flow(flow_braces) == flow) error stop 'to_flow' if (.not. to_flow(flow_mixed_braces) == flow) error stop 'to_flow' end block basic_flow multi_line_flow1: block character(len=*), parameter :: flow_multi = & '%YAML 1.1'//IO_EOL//& '---'//IO_EOL//& 'a: ["b",'//IO_EOL//& 'c: '//IO_EOL//& '"d", "e"]'//IO_EOL character(len=*), parameter :: flow = & '{a: ["b", {c: "d"}, "e"]}' if ( .not. to_flow(flow_multi) == flow) error stop 'to_flow' end block multi_line_flow1 multi_line_flow2: block character(len=*), parameter :: flow_multi = & "%YAML 1.1"//IO_EOL//& "---"//IO_EOL//& "-"//IO_EOL//& " a: {b:"//IO_EOL//& "[c,"//IO_EOL//& "d"//IO_EOL//& "e, f]}"//IO_EOL character(len=*), parameter :: flow = & "[{a: {b: [c, d e, f]}}]" if ( .not. to_flow(flow_multi) == flow) error stop 'to_flow' end block multi_line_flow2 basic_mixed: block character(len=*), parameter :: block_flow = & "%YAML 1.1"//IO_EOL//& " "//IO_EOL//& " "//IO_EOL//& "---"//IO_EOL//& " aa:"//IO_EOL//& " - "//IO_EOL//& " "//IO_EOL//& " "//IO_EOL//& " param_1: [a: b, c, {d: {e: [f: g, h]}}]"//IO_EOL//& " - c:d"//IO_EOL//& " e.f,"//IO_EOL//& " bb:"//IO_EOL//& " "//IO_EOL//& " - "//IO_EOL//& " {param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}"//IO_EOL//& "..."//IO_EOL character(len=*), parameter :: mixed_flow = & '{aa: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}, "c:d e.f,"], bb: [{param_1: [{a: b}, c, {d: {e: [{f: g}, h]}}]}]}' if (.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow' end block basic_mixed parse: block type(tDict), pointer :: dict type(tList), pointer :: list character(len=*), parameter :: & lst = '[1, 2, 3, 4]', & dct = '{a: 1, b: 2}' list => YAML_str_asList(lst//IO_EOL) if (list%asFormattedStr() /= lst) error stop 'str_asList' dict => YAML_str_asDict(dct//IO_EOL) if (dict%asFormattedStr() /= dct) error stop 'str_asDict' end block parse comment: block character(len=:), allocatable :: str,out str='#';out=clean(str) if (out /= '' .or. len(out) /= 0) error stop 'clean/1' str=' #';out=clean(str) if (out /= '' .or. len(out) /= 0) error stop 'clean/2' str=' # ';out=clean(str) if (out /= '' .or. len(out) /= 0) error stop 'clean/3' str=' # a';out=clean(str) if (out /= '' .or. len(out) /= 0) error stop 'clean/4' str=' a#';out=clean(str) if (out /= ' a' .or. len(out) /= 2) error stop 'clean/5' str=' ab #';out=clean(str) if (out /= ' ab'.or. len(out) /= 3) error stop 'clean/6' end block comment end subroutine YAML_selfTest #endif end module YAML