YamlReference 0.1 → 0.2
raw patch · 23 files changed
+292/−568 lines, 23 files
Files
- Text/Yaml/Reference.bnf +2/−2
- Text/Yaml/Reference.hs +270/−523
- YamlReference.cabal +4/−3
- tests/c-flow-mapping.n=4.c=flow-in.compact.output +0/−1
- tests/c-flow-mapping.n=4.c=flow-in.spaced.output +0/−1
- tests/c-flow-sequence.n=4.c=flow-in.compact.output +0/−1
- tests/c-flow-sequence.n=4.c=flow-in.spaced.output +0/−1
- tests/c-l-block-map-explicit-entry.n=2.output +0/−2
- tests/c-l-block-map-explicit-key.n=2.output +0/−1
- tests/c-l-block-map-implicit-value.n=2.plain.output +0/−1
- tests/c-l-block-seq-entry.n=2.output +0/−1
- tests/l+block-mapping.n=1.output +0/−1
- tests/l+block-sequence.n=1.output +0/−2
- tests/l-explicit-document.plain.output +0/−1
- tests/l-nb-folded-lines.n=4.output +0/−1
- tests/l-nb-spaced-lines.n=4.output +0/−1
- tests/l-trail-comments.n=4.invalid.output +1/−3
- tests/ns-l-in-line-mapping.n=2.output +0/−1
- tests/ns-l-in-line-sequence.n=3.invalid.output +0/−1
- tests/ns-l-in-line-sequence.n=3.output +0/−2
- tests/s-indent-le.n=4.invalid.output +1/−2
- tests/s-indent-lt.n=4.invalid.output +1/−2
- yeast2html +13/−14
Text/Yaml/Reference.bnf view
@@ -565,7 +565,7 @@ l_nb_start_with_folded n = ( l_empty n Folded *) & l_nb_folded_lines n- & "fold" ^ ( b_normalized & l_nb_start_with_spaced n ?)+ & ( b_normalized & l_nb_start_with_spaced n ?) s_nb_spaced_text n = s_indent n & s_white ! "fold" & ( nb_char *) b_l_spaced n = b_normalized & ( l_empty n Folded *)@@ -574,7 +574,7 @@ l_nb_start_with_spaced n = ( l_empty n Folded *) & l_nb_spaced_lines n- & "fold" ^ ( b_normalized & l_nb_start_with_folded n ?)+ & ( b_normalized & l_nb_start_with_folded n ?) l_nb_start_with_any n = "fold" ^ ( l_nb_start_with_folded n / l_nb_start_with_spaced n ) l_folded_content n t = ( l_nb_start_with_any n & b_chomped_last t ?)
Text/Yaml/Reference.hs view
@@ -53,6 +53,11 @@ import qualified Prelude import Prelude hiding ((/), (*), (+), (-), (^)) +-- * DeepSeq+--+-- Without this, memory consumption goes to infinity. This is a subset of Dean+-- Herington's code.+ -- * Generic operators -- -- ** Numeric operators@@ -376,15 +381,13 @@ -- | Parsed token. data Token = Token {- tCode :: Code, -- ^ Specific token 'Code'.- tText :: Maybe String -- ^ Contained input chars, if any.+ tCode :: Code, -- ^ Specific token 'Code'.+ tText :: String -- ^ Contained input chars, if any. } -- | @show token@ converts a 'Token' to a single YEAST line. instance Show Token where- show token = case token|>tText of- Nothing -> (show $ token|>tCode) ++ "\n"- Just string -> (show $ token|>tCode) ++ (escapeString string) ++ "\n"+ show token = (show $ token|>tCode) ++ (escapeString $ token|>tText) ++ "\n" -- | @escapeString string@ escapes all the non-ASCII characters in the -- /string/, as well as escaping the \"@\\@\" character, using the \"@\\xXX@\",@@ -429,11 +432,27 @@ -- so we maintain a single 'State' type rather than having a generic one that -- contains a polymorphic \"UserState\" field etc. --- | A 'Parser' is basically a function computing a /result/, while at the same--- time accumulating a list of 'Token'. A result of @Nothing@ indicates--- failure.-data Parser result = Parser (State -> (State, Maybe result))+-- | A 'Parser' is basically a function computing a 'Reply'.+data Parser result = Parser (State -> Reply result) +-- | A 'Reply' from a 'Parser'.+data Reply result = Reply {+ rResult :: Either String result, -- ^ Error or parsing result.+ rState :: State, -- ^ The updated parser state.+ rTokens :: D.DList Token, -- ^ Tokens generated by the parser.+ rCommits :: D.DList String, -- ^ Commitments to decision points.+ rDidConsume :: Bool -- ^ Whether any characters were consumed.+ }++-- Showing a 'State' is only used in debugging. Note that forcing dump of+-- @rTokens@, @rCommits@ or even @rDidConsume@ will prevent streaming them.+instance Show (Reply result) where+ show reply = -- "Result: " ++ (show $ reply|>rResult)+ "State: { " ++ (show $ reply|>rState) ++ "}"+ ++ ", Tokens: " ++ (show $ D.toList $ reply|>rTokens)+ ++ ", Commits: " ++ (show $ D.toList $ reply|>rCommits)+ ++ ", DidConsume: " ++ (show $ reply|>rDidConsume)+ -- A 'Pattern' is a parser that doesn't have an (interesting) result. type Pattern = Parser () @@ -442,50 +461,35 @@ -- | The internal parser state. We don't bother with parameterising it with a -- \"UserState\", we just bundle the generic and specific fields together (not -- that it is that easy to draw the line - is @sLine@ generic or specific?).--- Note that using 'DList' for @sTokens@ allows us to consume tokens as they--- are generated, instead of waiting for the whole parsing process to complete.--- Likewise for @sCommits@, which allows us to commit to a partially generated--- tokens stream before it is fully generated. data State = State {- -- Fields that never change, or only change for nested parsers:- sName :: String, -- ^ The input name for error messages.- sEncoding :: Encoding, -- ^ The input UTF encoding.- sDecision :: String, -- ^ Current decision name.- sLimit :: Int, -- ^ Lookahead characters limit.- sForbidden :: Maybe Pattern, -- ^ Pattern we must not enter into.- sIsPeek :: Bool, -- ^ Disables token generation.- -- Fields that get collected by consecutive parsers, then merged:- sTokens :: D.DList Token, -- ^ Tokens collected from input.- sCommits :: D.DList String, -- ^ Committments collected while parsing.- -- Fields that are incrementally modified by consecutive parsers:- sConsumed :: Bool, -- ^ Consumed character markers.- sChars :: D.DList Char, -- ^ Characters collected for a token.- sMessage :: Maybe String, -- ^ If an error occurred.- sLine :: Int, -- ^ Builds on YAML's line break definition.- sColumn :: Int, -- ^ Actually character number - we hate tabs.- sCode :: Code, -- ^ Of token we are collecting chars for.- sLast :: Char, -- ^ Last matched character.- sInput :: [Char] -- ^ The input decoded characters.+ sName :: !String, -- ^ The input name for error messages.+ sEncoding :: !Encoding, -- ^ The input UTF encoding.+ sDecision :: !String, -- ^ Current decision name.+ sLimit :: !Int, -- ^ Lookahead characters limit.+ sForbidden :: !(Maybe Pattern), -- ^ Pattern we must not enter into.+ sIsPeek :: !Bool, -- ^ Disables token generation.+ sChars :: ![Char], -- ^ (Reversed) characters collected for a token.+ sLine :: !Int, -- ^ Builds on YAML's line break definition.+ sColumn :: !Int, -- ^ Actually character number - we hate tabs.+ sCode :: !Code, -- ^ Of token we are collecting chars for.+ sLast :: !Char, -- ^ Last matched character.+ sInput :: [Char] -- ^ The input decoded characters. } --- Showing a 'State' is only used in debugging. Note that forcing certain--- members (@sTokens@, @sCommits@) may disable streaming.+-- Showing a 'State' is only used in debugging. Note that forcing dump of+-- @sInput@ will disable streamin it. instance Show State where show state = "Name: " ++ (show $ state|>sName)--- ++ ", Encoding: " ++ (show / state|>sEncoding)+ ++ ", Encoding: " ++ (show $ state|>sEncoding) ++ ", Decision: " ++ (show $ state|>sDecision)--- ++ ", Limit: " ++ (show / state|>sLimit)--- ++ ", IsPeek: " ++ (show / state|>sIsPeek)--- ++ ", Tokens:\n" ++ (showTokens / D.toList / state|>sTokens) ++ "...\n"--- ++ ", Commits: " ++ (show / D.toList / state|>sCommits)--- ++ ", Consumed: >>>" ++ (show / state|>sConsumed) ++ "<<<"--- ++ ", Chars: >>>" ++ (D.toList / state|>sChars) ++ "<<<"- ++ ", Message: " ++ (show $ state|>sMessage)+ ++ ", Limit: " ++ (show $ state|>sLimit)+ ++ ", IsPeek: " ++ (show $ state|>sIsPeek)+ ++ ", Chars: >>>" ++ (reverse $ state|>sChars) ++ "<<<" ++ ", Line: " ++ (show $ state|>sLine) ++ ", Column: " ++ (show $ state|>sColumn) ++ ", Code: " ++ (show $ state|>sCode) ++ ", Last: >>>" ++ (show $ state|>sLast) ++ "<<<"--- ++ ", Input: >>>" ++ (show / state|>sInput) ++ "<<<"+-- ++ ", Input: >>>" ++ (show $ state|>sInput) ++ "<<<" -- | @initialState name input@ returns an initial 'State' for parsing the -- /input/ (with /name/ for error messages).@@ -497,11 +501,7 @@ sLimit = -1, sForbidden = Nothing, sIsPeek = False,- sTokens = D.empty,- sCommits = D.empty,- sConsumed = False,- sChars = D.empty,- sMessage = Nothing,+ sChars = [], sLine = 1, sColumn = 0, sCode = Test,@@ -518,269 +518,19 @@ -- | @setDecision name state@ sets the @sDecision@ field to /decision/. setDecision :: String -> State -> State-setDecision decision state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = decision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }+setDecision decision state = state { sDecision = decision } -- | @setLimit limit state@ sets the @sLimit@ field to /limit/. setLimit :: Int -> State -> State-setLimit limit state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = limit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }+setLimit limit state = state { sLimit = limit } -- | @setForbidden forbidden state@ sets the @sForbidden@ field to /forbidden/. setForbidden :: Maybe Pattern -> State -> State-setForbidden forbidden state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = forbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setIsPeek isPeek state@ sets the @sIsPeek@ field to /isPeek/.-setIsPeek :: Bool -> State -> State-setIsPeek isPeek state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = isPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setTokens tokens state@ sets the @sTokens@ field to /tokens/.-setTokens :: D.DList Token -> State -> State-setTokens tokens state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = tokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setCommits commits state@ sets the @sCommits@ field to /commits/.-setCommits :: D.DList String -> State -> State-setCommits commits state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = commits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setChars chars state@ sets the @sChars@ field to /chars/.-setChars :: D.DList Char -> State -> State-setChars chars state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = chars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setConsumed consumed state@ sets the @sConsumed@ field to /consumed/.-setConsumed :: Bool -> State -> State-setConsumed consumed state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = consumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setMessage message state@ sets the @sMessage@ field to /message/.-setMessage :: Maybe String -> State -> State-setMessage message state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = message,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setLine line state@ sets the @sLine@ field to /line/.-setLine :: Int -> State -> State-setLine line state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = line,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setColumn line state@ sets the @sColumn@ field to /line/.-setColumn :: Int -> State -> State-setColumn column state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = column,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = state|>sInput }+setForbidden forbidden state = state { sForbidden = forbidden } -- | @setCode code state@ sets the @sCode@ field to /code/. setCode :: Code -> State -> State-setCode code state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = code,- sLast = state|>sLast,- sInput = state|>sInput }---- | @setLast last state@ sets the @sLast@ field to /last/.-setLast :: Char -> State -> State-setLast last state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = last,- sInput = state|>sInput }---- | @setInput input state@ sets the @sInput@ field to /input/.-setInput :: [Char] -> State -> State-setInput input state = State { sName = state|>sName,- sEncoding = state|>sEncoding,- sDecision = state|>sDecision,- sLimit = state|>sLimit,- sForbidden = state|>sForbidden,- sIsPeek = state|>sIsPeek,- sTokens = state|>sTokens,- sCommits = state|>sCommits,- sConsumed = state|>sConsumed,- sChars = state|>sChars,- sMessage = state|>sMessage,- sLine = state|>sLine,- sColumn = state|>sColumn,- sCode = state|>sCode,- sLast = state|>sLast,- sInput = input }+setCode code state = state { sCode = code } -- ** Implicit parsers --@@ -795,7 +545,7 @@ -- | @parse parser state@ applies the actual /parser/ match function to a -- /state/.-parse :: (Match match result) => match -> State -> (State, Maybe result)+parse :: (Match match result) => match -> State -> Reply result parse parser state = let Parser parser' = match parser in parser' state @@ -810,13 +560,12 @@ -- | We convert a 'Char' tuple to a parser for a character range (that returns -- nothing). instance Match (Char, Char) () where- match (low, high) = nextIf (\ code -> low <= code && code <= high)+ match (low, high) = nextIf $ \ code -> low <= code && code <= high -- | We convert 'String' to a parser for a sequence of characters (that returns -- nothing). instance Match String () where- match "" = empty- match (first:rest) = match first & match rest+ match = foldr (&) empty -- ** Parsing Monad @@ -825,44 +574,60 @@ -- -- We don't use the 'Monad' @fail@ method because we need access to the 'State' -- on failure.------ @return result@ does just that - return a /result/.------ @left >>= right@ applies the /left/ parser, and if it didn't fail--- applies the /right/ one (well, the one /right/ returns). To achieve--- streaming, we need to construct the final state manually, \"regardless\" of--- the result of the right parser, and append the collected tokens and--- commitments from the left and right parser. This allows our caller to--- start consuming tokens from the left parser before the right parser is--- done.------ This code seems to hang on to the old states for too long a time, causing--- memory usage to grow up when creating long parser chains (e.g. using @*@). instance Monad Parser where - return result = Parser (\ state -> (state, Just result))+ -- | @return result@ does just that - return a /result/.+ return result = Parser $ \ state -> returnReply state result + -- | @left >>= right@ applies the /left/ parser, and if it didn't fail+ -- applies the /right/ one (well, the one /right/ returns). For streaming it+ -- is vital that we return a value "regardless" of the result of the left+ -- parser. The fields in the reply are populated at different rates (in+ -- particular, tokens are made available before the final result is known). left >>= right =- Parser (\ originalState -> let (leftState, leftResult) = parse left originalState- leftTokens = leftState|>sTokens- leftCommits = leftState|>sCommits- leftConsumed = leftState|>sConsumed- leftState' = setTokens D.empty- $ setCommits D.empty - $ setConsumed False- $ leftState- (rightState, rightResult) = case leftResult of- Nothing -> (leftState', Nothing)- Just value -> parse (right value) leftState'- rightTokens = rightState|>sTokens- rightCommits = rightState|>sCommits- rightConsumed = rightState|>sConsumed- finalState = setTokens (D.append leftTokens rightTokens)- $ setCommits (D.append leftCommits rightCommits)- $ setConsumed (leftConsumed || rightConsumed)- $ rightState- in (finalState, rightResult))+ Parser $ \ originalState -> let leftReply = parse left originalState+ rightReply = case leftReply|>rResult of+ Right value -> parse (right value) $ leftReply|>rState+ Left message -> failReply (leftReply|>rState) message+ in bindReply leftReply rightReply + -- | @fail message@ does just that - failes with a /message/.+ fail message = Parser $ \ state -> failReply state message++-- | @returnReply state result@ prepares a 'Reply' with the specified /state/+-- and /result/.+returnReply :: State -> result -> Reply result+returnReply state result = Reply { rResult = Right result,+ rState = state,+ rTokens = D.empty,+ rCommits = D.empty,+ rDidConsume = False }++-- NOTE: The profiler is blaming @bindReply@ at retaining old state and+-- reply objects. How come?++-- | @bindReply left right@ combines the replies of the /left/ and /right/+-- parsers to a single reply, allowing for generated 'Token' to be consumed+-- before parsing is completed.+bindReply :: Reply result1 -> Reply result2 -> Reply result2+bindReply left right = Reply { rResult = right|>rResult,+ rState = right|>rState,+ rTokens = D.append (left|>rTokens) (right|>rTokens),+ rCommits = D.append (left|>rCommits) (right|>rCommits),+ rDidConsume = (left|>rDidConsume) || (right|>rDidConsume) }++-- | @failReply state message@ prepares a 'Reply' with the specified /state/+-- and error /message/.+failReply :: State -> String -> Reply result+failReply state message = Reply { rResult = Left $ state|>sName+ ++ ": line " ++ (show $ state|>sLine)+ ++ ": column " ++ (show $ state|>sColumn)+ ++ ": " ++ message,+ rState = state,+ rTokens = D.empty,+ rCommits = D.empty,+ rDidConsume = False }+ -- ** Parsing operators -- -- Here we reap the benefits of renaming the numerical operators. Note that in@@ -925,9 +690,9 @@ -- | @parser <% n@ matches fewer than /n/ occurrences of /parser/. (<%) :: (Match match result) => match -> Int -> Pattern parser <% n- | n < 1 = failed "Fewer than 0 repetitions"+ | n < 1 = fail "Fewer than 0 repetitions" | n == 1 = reject parser Nothing- | n > 1 = parser & parser <% n .- 1 / empty+ | n > 1 = "<%" ^ ( parser ! "<%" & parser <% n .- 1 / empty ) -- | @parser - rejected@ matches /parser/, except if /rejected/ matches at this -- point.@@ -939,45 +704,25 @@ (&) :: (Match match1 result1, Match match2 result2) => match1 -> match2 -> Parser result2 before & after = (match before) >> (match after) --- | @first \/ second@ tries to parse /first/, and failing that parses /second/,--- unless /first/ has committed in which case is fails immediately. To achieve--- streaming, we need to construct the final state manually, passing the--- commitments through \"regardless\" of the results of either parsers. This--- allows our caller to start consuming tokens from a committed option before--- it is done parsing.------ This code seems to hang on to the old states for too long a time, causing--- memory usage to grow up when creating long parser chains (e.g. using @*@).+-- | @first \/ second@ tries to parse /first/, and failing that parses+-- /second/, unless /first/ has committed in which case is fails immediately.+-- To achieve streaming, we need to construct the final state manually, passing+-- the commitments through \"regardless\" of the results of either parsers.+-- This allows our caller to start consuming tokens from a committed option+-- before it is done parsing. (/) :: (Match match1 result, Match match2 result) => match1 -> match2 -> Parser result first / second =- Parser (\ originalState ->- let decision = originalState|>sDecision- originalTokens = originalState|>sTokens- originalCommits = originalState|>sCommits- originalConsumed = originalState|>sConsumed- nestState = setDecision "n/a"- $ setTokens D.empty- $ setCommits D.empty- $ setConsumed False- $ originalState- (firstState, firstResult) = parse first nestState- (firstIsCommitted, firstCommits) = commitStatus "n/a" decision $ D.toList $ firstState|>sCommits- (chosenState, chosenResult, chosenCommits) =- if firstIsCommitted- then (firstState, firstResult, firstCommits)- else case firstResult of- Just _ -> (firstState, firstResult, firstCommits)- Nothing -> let (secondState, secondResult) = parse second nestState- secondCommits = snd $ commitStatus "n/a" decision $ D.toList $ secondState|>sCommits- in (secondState, secondResult, secondCommits)- chosenTokens = chosenState|>sTokens- chosenConsumed = chosenState|>sConsumed- finalState = setTokens (D.append originalTokens chosenTokens)- $ setCommits (D.append originalCommits chosenCommits)- $ setConsumed (originalConsumed || chosenConsumed)- $ setDecision decision- $ chosenState- in (finalState, chosenResult))+ Parser $ \ originalState -> let decision = originalState|>sDecision+ nestState = originalState { sDecision = "n/a" }+ firstReply = parse first nestState+ (firstIsCommitted, firstCommits) = commitStatus "n/a" decision $ D.toList $ firstReply|>rCommits+ in if firstIsCommitted+ then firstReply { rCommits = firstCommits }+ else case firstReply|>rResult of+ Right _ -> firstReply { rCommits = firstCommits }+ Left _ -> let secondReply = parse second nestState+ (_, secondCommits) = commitStatus "n/a" decision $ D.toList $ secondReply|>rCommits+ in secondReply { rCommits = secondCommits } where commitStatus :: String -> String -> [String] -> (Bool, D.DList String) commitStatus prev decision [] = (False, D.empty) commitStatus prev decision (name:rest) | name == decision = (True, snd $ commitStatus prev decision rest)@@ -986,113 +731,93 @@ -- | @(parser ?)@ (optional) tries to match /parser/, otherwise does nothing. (?) :: (Match match result) => match -> Pattern-(?) parser = non_empty parser & empty / empty+(?) parser = Parser $ \ state -> let reply = parse parser state+ in case reply|>rResult of+ Right _ -> reply { rResult = Right () }+ Left _ -> returnReply state () --- | @(parser *)@ matches zero or more occurrences of /parser/.+-- | @(parser *)@ matches zero or more occurrences of /parser/. Tricky+-- optimization: we only return the commitments of the first match. In the YAML+-- syntax, the additional occurences will only repeat them. (*) :: (Match match result) => match -> Pattern-(*) parser = "*" ^ ( non_empty parser ! "*" & (parser *) / empty )+(*) parser = Parser zero_or_more+ where zero_or_more state = let reply = parse parser state+ in case (reply|>rResult, reply|>rDidConsume) of+ (Left _, _) -> returnReply state ()+ (Right _, False) -> returnReply state ()+ (Right _, True) -> let reply' = zero_or_more $ reply|>rState+ in bindReply reply reply' { rCommits = D.empty } -- | @(parser +)@ matches one or more occurrences of /parser/. (+) :: (Match match result) => match -> Pattern-(+) parser = non_empty parser & (parser *)+(+) parser = parser & (parser *) -- ** Basic parsers -- | @traced name parser@ traces all invocations to the parser. Is only used when -- debugging. traced :: (Match match result, Show result) => String -> match -> Parser result-traced name parser = Parser (\ state -> trace_reply name (parse parser (trace_call name state)))+traced name parser = Parser $ \ state -> trace_reply name $ parse parser $ trace_call name state -- | @trace_call name state@ traces the /state/ at the start of the call to /name/. trace_call :: String -> State -> State trace_call name state = trace ("Call " ++ name ++ " with " ++ (show state)) state -- | @trace_call name reply@ traces the /reply/ from calling /name/.-trace_reply :: Show result => String -> (State, Maybe result) -> (State, Maybe result)-trace_reply name reply@(state, result) =- case result of- Nothing -> trace ("Fail " ++ name ++ " with " ++ (show state)) reply- Just value -> trace ("Done " ++ name ++ " with " ++ (show state)) reply+trace_reply :: Show result => String -> Reply result -> Reply result+trace_reply name reply = trace ("Done " ++ name ++ " with " ++ (show reply)) reply -- | @reject rejected name@ fails if /rejected/ matches at this point, and does -- nothing otherwise. If /name/ is provided, it is used in the error message, -- otherwise the messages uses the current character. reject :: (Match match result) => match -> Maybe String -> Pattern-reject rejected name =- Parser (\ state -> let (_, result) = parse rejected $ setIsPeek True state- parser' = case (result, name) of- (Nothing, _) -> empty- (Just _, Nothing) -> consumeNextIf (const False)- (Just _, Just text) -> failed $ "Unexpected " ++ text- in parse parser' state)+reject rejected name = Parser $ \ state -> let reply = parse rejected state { sIsPeek = True }+ in case (reply|>rResult, name) of+ (Left _, _) -> returnReply state ()+ (Right _, Nothing) -> unexpectedReply state+ (Right _, Just text) -> failReply state $ "Unexpected " ++ text -- | @peek parser@ succeeds if /parser/ matches at this point, but does not -- consume any input. peek :: (Match match result) => match -> Parser result-peek parser = Parser (\ state -> let (_, result) = parse parser $ setIsPeek True state- in case result of- Nothing -> (setFailed "Peek failed" state, Nothing)- Just _ -> (state, result))---- | @non_empty parser@ matches the same as /parser/ as long as it consumes some--- characters.-non_empty :: (Match match result) => match -> Parser result-non_empty parser =- Parser (\ originalState -> let nestState = setConsumed False originalState- (parseState, parseResult) = parse parser nestState- in case (parseState|>sConsumed, parseResult) of- (True, _) -> (parseState, parseResult)- (False, Nothing) -> (parseState, parseResult)- (False, Just _) -> (setFailed "Parser does not consume characters" originalState, Nothing))+peek parser = Parser $ \ state -> let reply = parse parser state { sIsPeek = True }+ in case reply|>rResult of+ Right value -> returnReply state value+ Left _ -> failReply state "Peek failed" -- | @empty@ always matches without consuming any input. empty :: Pattern empty = return () --- | @setFailed state message@ sets the @sMessage@ field to the error /message/.-setFailed :: String -> State -> State-setFailed message state = setMessage (Just $ state|>sName- ++ ": line " ++ (show $ state|>sLine)- ++ ": column " ++ (show $ state|>sColumn)- ++ ": " ++ message)- state---- | @failed message@ fails parsing with the specified /message/. Note this is--- not the 'Monad' @fail@ method, which we do not use.-failed :: String -> Parser result-failed message = Parser (\ state -> (setFailed message state, Nothing))- -- | @eof@ matches the end of the input. eof :: Pattern-eof = Parser (\ state -> if state|>sInput == []- then (state, Just ())- else (setFailed "Expected end of input" state, Nothing))+eof = Parser $ \ state -> if state|>sInput == []+ then returnReply state ()+ else failReply state "Expected end of input" -- | @sol@ matches the start of a line. sol :: Pattern-sol = Parser (\ state -> if state|>sColumn == 0- then (state, Just ())- else (setFailed "Expected start of line" state, Nothing))+sol = Parser $ \ state -> if state|>sColumn == 0+ then returnReply state ()+ else failReply state "Expected start of line" -- ** State manipulation pseudo-parsers -- | @incrLine@ increments @sLine@ counter resets @sColumn@. nextLine :: Pattern-nextLine = Parser (\ state -> (setLine (state|>sLine .+ 1)- $ setColumn 0- $ state,- Just ()))+nextLine = Parser $ \ state -> returnReply state { sLine = state|>sLine .+ 1,+ sColumn = 0 }+ () -- | @with setField getField value parser@ invokes the specified /parser/ with -- the value of the specified field set to /value/ for the duration of the -- invocation, using the /setField/ and /getField/ functions to manipulate it. with :: (value -> State -> State) -> (State -> value) -> value -> Parser result -> Parser result-with setField getField value parser =- Parser (\ originalState -> let originalValue = getField originalState- withState = setField value originalState- (parseState, parseResult) = parse parser withState- finalState = setField originalValue parseState- in (finalState, parseResult))+with setField getField value parser = Parser $ \ originalState -> let originalValue = getField originalState+ withState = setField value originalState+ reply = parse parser withState+ finalState = setField originalValue $ reply|>rState+ in reply { rState = finalState } -- | @decide name (a / b / ...)@ names the contained decision point so it can be -- addressed by later @commit@ calls.@@ -1103,7 +828,11 @@ -- containing decision with the specified /name/. This makes all tokens -- generated in this parsing path immediately available to the caller. commit :: String -> Pattern-commit name = Parser (\ state -> (setCommits (D.snoc (state|>sCommits) name) state, Just ()))+commit name = Parser $ \ state -> Reply { rResult = Right (),+ rState = state,+ rTokens = D.empty,+ rCommits = D.singleton name,+ rDidConsume = False } -- | @parser ``forbidding`` pattern@ parses the specified /parser/ ensuring -- that it does not contain anything matching the /forbidden/ parser.@@ -1117,75 +846,81 @@ -- ** Consuming input characters --- | @consumeNextIf test@ consumes and returns the next character if it satisfies--- the /test/.-consumeNextIf :: (Char -> Bool) -> Pattern-consumeNextIf test = - Parser (\ state -> case state|>sInput of- (char:rest) | test char -> (setInput rest- $ setLast char- $ setColumn (state|>sColumn .+ 1)- $ setChars (D.snoc (state|>sChars) char)- $ setConsumed True- $ state,- Just ())- | otherwise -> (setFailed ("Unexpected '" ++ [char] ++ "'") state, Nothing)- [] -> (setFailed "Unexpected end of input" state, Nothing))---- | @limitedNextIf test@ fails if the 'State' lookahead limit is reached.--- Otherwise it consumes and returns the specified input char if it satisfies--- /test/.-limitedNextIf :: (Char -> Bool) -> Pattern-limitedNextIf test =- Parser (\ state -> case state|>sLimit of- -1 -> parse (consumeNextIf test) state- 0 -> (setFailed "Lookahead limit reached" state, Nothing)- limit -> parse (consumeNextIf test) $ setLimit (limit .- 1) state)- -- | @nextIf test@ fails if the current position matches the 'State' forbidden -- pattern or if the 'State' lookahead limit is reached. Otherwise it consumes -- (and buffers) the next input char if it satisfies /test/. nextIf :: (Char -> Bool) -> Pattern-nextIf test =- Parser (\ state -> case state|>sForbidden of- Nothing -> parse (limitedNextIf test) state- Just parser -> let (_, result) = parse parser $ setIsPeek True- $ setForbidden Nothing- $ state- in case result of- Nothing -> parse (limitedNextIf test) state- Just _ -> (setFailed "Forbidden pattern detected" state, Nothing))+nextIf test = Parser $ \ state -> case state|>sForbidden of+ Nothing -> limitedNextIf state+ Just parser -> let reply = parse parser state { sIsPeek = True,+ sForbidden = Nothing }+ in case reply|>rResult of+ Left _ -> limitedNextIf state+ Right _ -> failReply state "Forbidden pattern detected"+ where limitedNextIf state = case state|>sLimit of+ -1 -> consumeNextIf state+ 0 -> failReply state "Lookahead limit reached"+ limit -> consumeNextIf state { sLimit = state|>sLimit .- 1 }+ consumeNextIf state = case state|>sInput of+ (char:rest) | test char -> let chars = if state|>sIsPeek+ then []+ else char:(state|>sChars)+ state' = state { sInput = rest,+ sLast = char,+ sChars = chars,+ sColumn = state|>sColumn .+ 1 }+ in Reply { rResult = Right (),+ rState = state',+ rTokens = D.empty,+ rCommits = D.empty,+ rDidConsume = True }+ | otherwise -> unexpectedReply state+ [] -> unexpectedReply state +-- | @unexpectedReply state@ returns a @failReply@ for an unexpected character.+unexpectedReply :: State -> Reply ()+unexpectedReply state = case state|>sInput of+ (char:_) -> failReply state $ "Unexpected '" ++ [char] ++ "'"+ [] -> failReply state "Unexpected end of input"+ -- ** Producing tokens -- | @finishToken@ places all collected text into a new token and begins a new -- one, or does nothing if there are no collected characters. finishToken :: Pattern-finishToken =- Parser (\ state -> let chars = D.toList $ state|>sChars- token = Token { tCode = state|>sCode, tText = Just chars }- in if state|>sIsPeek || chars == ""- then (state, Just ())- else (setTokens (D.snoc (state|>sTokens) token)- $ setChars D.empty- $ state,- Just ()))+finishToken = Parser $ \ state -> if state|>sIsPeek+ then returnReply state ()+ else case state|>sChars of+ [] -> returnReply state ()+ chars@(_:_) -> tokenReply state Token { tCode = state|>sCode,+ tText = reverse chars } +-- | @tokenReply state token@ returns a 'Reply' containing the /state/ and+-- /token/. Any collected characters are cleared (either there are none, or we+-- put them in this token, or we don't want them).+tokenReply state token = Reply { rResult = Right (),+ rState = state { sChars = [] },+ rTokens = D.singleton token,+ rCommits = D.empty,+ rDidConsume = False }+ -- | @wrap parser@ invokes the /parser/, ensures any unclaimed input characters -- are wrapped into a token (only happens when testing productions), ensures no -- input is left unparsed, and returns the parser's result. wrap :: (Match match result) => match -> Parser result wrap parser = do result <- match parser- finishToken & eof+ finishToken+ eof return result -- | @consume parser@ invokes the /parser/ and then consumes all remaining -- unparsed input characters. consume :: (Match match result) => match -> Parser result consume parser = do result <- match parser- finishToken & clear_input+ finishToken+ clear_input return result- where clear_input = Parser (\ state -> (setInput [] state, Just ()))+ where clear_input = Parser $ \ state -> returnReply state { sInput = [] } () -- | @token code parser@ places all text matched by /parser/ into a 'Token' with -- the specified /code/ (unless it is empty). Note it collects the text even if@@ -1194,13 +929,12 @@ token code parser = finishToken & with setCode sCode code (parser & finishToken) -- | @fake code text@ creates a token with the specified /code/ and \"fake\"--- /text/ characters.+-- /text/ characters, instead of whatever characters are collected so far. fake :: Code -> String -> Pattern-fake code text =- Parser (\ state -> if state|>sIsPeek- then (state, Just())- else let token = Token { tCode = code, tText = Just text }- in (setTokens (D.snoc (state|>sTokens) token) state, Just ()))+fake code text = Parser $ \ state -> if state|>sIsPeek+ then returnReply state ()+ else tokenReply state Token { tCode = code,+ tText = text } -- | @meta parser@ collects the text matched by the specified /parser/ into a -- | @Meta@ token.@@ -1220,12 +954,12 @@ -- | @nest code@ returns an empty token with the specified begin\/end /code/ to -- signal nesting. nest :: Code -> Pattern-nest code =- Parser (\ state -> if state|>sIsPeek- then (state, Just())- else let (state', _) = parse finishToken state- token = Token { tCode = code, tText = Nothing }- in (setTokens (D.snoc (state'|>sTokens) token) state', Just ()))+nest code = Parser $ \ state -> if state|>sIsPeek+ then returnReply state ()+ else let left = parse finishToken state+ right = tokenReply state Token { tCode = code,+ tText = "" }+ in bindReply left right -- * Production parameters @@ -1320,36 +1054,51 @@ -- the result without preventing the streaming. patternTokenizer :: Pattern -> Tokenizer patternTokenizer pattern name input =- let (state, result) = parse (wrap pattern) (initialState name input)- last = case result of- Just _ -> D.empty- Nothing -> D.singleton Token { tCode = Error, tText = state|>sMessage }- bugs = commitBugs $ D.toList $ state|>sCommits+ let reply = parse (wrap pattern) (initialState name input)+ last = case reply|>rResult of+ Right _ -> D.empty+ Left message -> D.singleton Token { tCode = Error,+ tText = message }+ bugs = commitBugs "n/a" $ D.toList $ reply|>rCommits errors = D.append bugs last- in D.toList $ D.append (state|>sTokens) errors+ in D.toList $ D.append (reply|>rTokens) errors +{- NOTE: the 'debug-leak' production will run in constant memory "forever" when+ - using the following instead - that is, discarding the result and+ - commitments.++patternTokenizer pattern name input =+ let reply = parse pattern (initialState name input)+ in D.toList $ reply|>rTokens++-}+ -- | @parserTokenizer what parser@ converts the /parser/ returning /what/ to a -- simple 'Tokenizer' (only used for tests). Note how using difference lists we -- can tuck the result or error token at the end of the result without -- preventing the streaming. parserTokenizer :: (Show result, Match match result) => String -> match -> Tokenizer parserTokenizer what parser name input =- let (state, result) = parse (wrap parser) (initialState name input)- last = case result of- Just value -> Token { tCode = Detected, tText = Just $ what ++ "=" ++ (show value) }- Nothing -> Token { tCode = Error, tText = state|>sMessage }- bugs = commitBugs $ D.toList $ state|>sCommits+ let reply = parse (wrap parser) (initialState name input)+ last = case reply|>rResult of+ Right value -> Token { tCode = Detected,+ tText = what ++ "=" ++ (show value) }+ Left message -> Token { tCode = Error,+ tText = message }+ bugs = commitBugs "n/a" $ D.toList $ reply|>rCommits errors = D.snoc bugs last- in D.toList $ D.append (state|>sTokens) errors+ in D.toList $ D.append (reply|>rTokens) errors -- | @commitBugs commits@ converts any @commit@ calls made outside the decision -- they refer to into an error token. No such calls should exists outside -- tests.-commitBugs :: [String] -> D.DList Token-commitBugs [] = D.empty-commitBugs (decision:rest) =- D.cons Token { tCode = Error, tText = Just $ "Commit to '" ++ decision ++ "' was made outside it" }- $ commitBugs rest+commitBugs :: String -> [String] -> D.DList Token+commitBugs prev [] = D.empty+commitBugs prev (decision:rest)+ | decision == prev = commitBugs prev rest+ | otherwise = D.cons Token { tCode = Error,+ tText = "Commit to '" ++ decision ++ "' was made outside it" }+ $ commitBugs decision rest -- | @yaml name input@ converts the Unicode /input/ (called /name/ in error -- messages) to a list of 'Token' according to the YAML spec. This is it!@@ -1743,13 +1492,11 @@ -- | @detect_utf_encoding@ doesn't actually detect the encoding, we just call it -- this way to make the productions compatible with the spec. Instead it simply -- reports the encoding (which was already detected when we started parsing).-detect_utf_encoding = Parser (\ state -> let text = case state|>sEncoding of- UTF8 -> "TF8"- UTF16LE -> "TF16LE"- UTF16BE -> "TF16BE"- in parse (fake Bom text) $ setChars D.empty- $ setColumn (state|>sColumn .- 1)- $ state)+detect_utf_encoding = Parser $ \ state -> let text = case state|>sEncoding of+ UTF8 -> "TF8"+ UTF16LE -> "TF16LE"+ UTF16BE -> "TF16BE"+ in parse (fake Bom text) state { sColumn = state|>sColumn .- 1 } -- | @na@ is the \"non-applicable\" indentation value. We use Haskell's laziness -- to verify it really is never used.@@ -1759,7 +1506,7 @@ -- | @asInteger@ returns the last consumed character, which is assumed to be a -- decimal digit, as an integer. asInteger :: Parser Int-asInteger = Parser (\ state -> (state, Just $ ord (state|>sLast) .- 48))+asInteger = Parser $ \ state -> returnReply state $ ord (state|>sLast) .- 48 -- | @result value@ is the same as /return value/ except that we give the -- Haskell type deduction the additional boost it needs to figure out this is
YamlReference.cabal view
@@ -1,5 +1,5 @@ Name: YamlReference-Version: 0.1+Version: 0.2 License: LGPL License-File: lgpl.txt Copyright: Oren Ben-Kiki 2007@@ -7,7 +7,8 @@ Maintainer: yaml-oren@ben-kiki.org Stability: alpha Homepage: www.ben-kiki.org/oren/YamlReference-Package-Url: www.ben-kiki.org/oren/YamlReference/YamlReference-0.1.tar.gz+Package-Url: www.ben-kiki.org/oren/YamlReference/YamlReference-0.2.tar.gz+Category: Text Synopsis: YAML reference implementation Description: This package contains \"the\" reference YAML syntax parser ("Text.Yaml.Reference"), generated directly from the YAML@@ -19,7 +20,7 @@ interesting tools on top of it, such as the @yeast2html@ YAML syntax visualizer (contained in this package), pretty printers, etc. This is a streaming parser that will- \"immediately\" begin to generate output, but it has a memoy+ \"immediately\" begin to generate output, but it has a memory leak (actually, retention) problem that prevents it from being applied to \"large\" files. To debug this with minimal syntax productions use @yes "#" | yaml2yeast -p debug-leak@.
tests/c-flow-mapping.n=4.c=flow-in.compact.output view
@@ -58,4 +58,3 @@ I} m !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-flow-mapping.n=4.c=flow-in.spaced.output view
@@ -68,4 +68,3 @@ I} m !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-flow-sequence.n=4.c=flow-in.compact.output view
@@ -25,4 +25,3 @@ I] q !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-flow-sequence.n=4.c=flow-in.spaced.output view
@@ -31,4 +31,3 @@ I] q !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-l-block-map-explicit-entry.n=2.output view
@@ -16,5 +16,3 @@ n b\x0a !Commit to 'node' was made outside it-!Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-l-block-map-explicit-key.n=2.output view
@@ -7,4 +7,3 @@ n b\x0a !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-l-block-map-implicit-value.n=2.plain.output view
@@ -7,4 +7,3 @@ n b\x0a !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/c-l-block-seq-entry.n=2.output view
@@ -7,4 +7,3 @@ n b\x0a !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/l+block-mapping.n=1.output view
@@ -37,4 +37,3 @@ x m !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/l+block-sequence.n=1.output view
@@ -50,5 +50,3 @@ n q !Commit to 'node' was made outside it-!Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/l-explicit-document.plain.output view
@@ -18,4 +18,3 @@ o o !Commit to 'doc' was made outside it-!Commit to 'doc' was made outside it
tests/l-nb-folded-lines.n=4.output view
@@ -8,4 +8,3 @@ i ?c !Commit to 'fold' was made outside it-!Commit to 'fold' was made outside it
tests/l-nb-spaced-lines.n=4.output view
@@ -8,4 +8,3 @@ i ? c !Commit to 'fold' was made outside it-!Commit to 'fold' was made outside it
tests/l-trail-comments.n=4.invalid.output view
@@ -1,3 +1,1 @@-i -C-!$InputFile$: line 1: column 2: Unexpected ' '+!$InputFile$: line 1: column 3: Unexpected ' '
tests/ns-l-in-line-mapping.n=2.output view
@@ -34,4 +34,3 @@ m n !Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/ns-l-in-line-sequence.n=3.invalid.output view
@@ -11,5 +11,4 @@ q n !Commit to 'node' was made outside it-!Commit to 'node' was made outside it !$InputFile$: line 2: column 0: Expected end of input
tests/ns-l-in-line-sequence.n=3.output view
@@ -20,5 +20,3 @@ q n !Commit to 'node' was made outside it-!Commit to 'node' was made outside it-!Commit to 'node' was made outside it
tests/s-indent-le.n=4.invalid.output view
@@ -1,2 +1,1 @@-i -!$InputFile$: line 1: column 3: Expected end of input+!$InputFile$: line 1: column 4: Unexpected ' '
tests/s-indent-lt.n=4.invalid.output view
@@ -1,2 +1,1 @@-i -!$InputFile$: line 1: column 2: Expected end of input+!$InputFile$: line 1: column 3: Unexpected ' '
yeast2html view
@@ -138,7 +138,6 @@ sub print_output { print $output <<"EOF";-<html> <?xml version="1.0" encoding="ISO-8859-1"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"@@ -250,8 +249,8 @@ } sub print_tree {- print $output "<div id=\"tree_div\" name=\"tree_div\" class=\"tree_div\">\n";- print $output "<h1 id=\"tree_title\" name=\"tree_title\" class=\"tree_title\">$tree_title</h1>";+ print $output "<div id=\"tree_div\" class=\"tree_div\">\n";+ print $output "<h1 id=\"tree_title\" class=\"tree_title\">$tree_title</h1>"; $next_id = 0; start_tree_node(0, "Legend"); print_legend();@@ -276,15 +275,15 @@ sub start_tree_node { my $depth = shift; my $text = shift;- print $output "<div id=\"tree_line_$next_id\" name=\"tree_line_$next_id\" class=\"tree_node parent_node\">\n";+ print $output "<div id=\"tree_line_$next_id\" class=\"tree_node parent_node\">\n"; for (my $i = 1; $i <= $depth; $i++) { print $output "<span class=\"tree_space parent_node space_$i depth_$depth\"> </span>" }- print $output "<span id=\"tree_glyph_$next_id\" name=\"tree_glyph_$next_id\" class=\"tree_glyph parent_node\" onclick=\"toggle($next_id)\">—</span>";- print $output "<span id=\"tree_text_$next_id\" name=\"tree_text_$next_id\" class=\"tree_text parent_node"+ print $output "<span id=\"tree_glyph_$next_id\" class=\"tree_glyph parent_node\" onclick=\"toggle($next_id)\">—</span>";+ print $output "<span id=\"tree_text_$next_id\" class=\"tree_text parent_node" . ($next_id > 0 ? "" : " legend_node") . "\" onclick=\"highlight($next_id)\">$text</span>\n";- print $output "<div id=\"tree_nest_$next_id\" name=\"tree_nest_$next_id\" class=\"tree_nest\">\n";+ print $output "<div id=\"tree_nest_$next_id\" class=\"tree_nest\">\n"; $next_id++; } @@ -295,19 +294,19 @@ sub tree_leaf { my $depth = shift; my $text = shift;- print $output "<div id=\"tree_line_$next_id\" name=\"tree_line_$next_id\" class=\"tree_node leaf_node\">\n";+ print $output "<div id=\"tree_line_$next_id\" class=\"tree_node leaf_node\">\n"; for (my $i = 1; $i <= $depth; $i++) { print $output "<span class=\"tree_space leaf_node space_$i depth_$depth\"> </span>" }- print $output "<span id=\"tree_glyph_$next_id\" name=\"tree_glyph_$next_id\" class=\"tree_glyph leaf_node\"\">·</span>";- print $output "<span id=\"tree_text_$next_id\" name=\"tree_text_$next_id\" class=\"tree_text leaf_node\" onclick=\"highlight($next_id)\">$text</span>\n";+ print $output "<span id=\"tree_glyph_$next_id\" class=\"tree_glyph leaf_node\">·</span>";+ print $output "<span id=\"tree_text_$next_id\" class=\"tree_text leaf_node\" onclick=\"highlight($next_id)\">$text</span>\n"; print $output "</div>\n"; $next_id++; } sub print_legend { print <<"EOF";-<table id="legend_table" name="legend_table" class="legend_table">+<table id="legend_table" class="legend_table"> <tr> <td class="legend_space"> </td> <td class="legend_glyph">↵</td>@@ -363,8 +362,8 @@ } sub print_text {- print $output "<div id=\"text_div\" name=\"text_div\" class=\"text_div\">\n";- print $output "<h1 id=\"text_title\" name=\"text_title\" class=\"text_title\">$text_title</h1>";+ print $output "<div id=\"text_div\" class=\"text_div\">\n";+ print $output "<h1 id=\"text_title\" class=\"text_title\">$text_title</h1>"; $next_id = 1; my $pending_break = 0; for my $entry (@$data) {@@ -377,7 +376,7 @@ print $output "<br/>\n"; $pending_break = 0; }- print $output "<span id=\"text_$next_id\" name=\"text_$next_id\" class=\"text\"";+ print $output "<span id=\"text_$next_id\" class=\"text\""; print " onclick=\"highlight($next_id)\"" unless $class->{type} eq 'begin'; print ">"; $next_id++;