Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add EmptyLine Event #50

Closed
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 11 additions & 2 deletions src/Data/YAML/Event.hs
Original file line number Diff line number Diff line change
Expand Up @@ -139,22 +139,30 @@ fixUpEOS = go initPos
-- (which will be auto-detected).
--
parseEvents :: BS.L.ByteString -> EvStream
parseEvents = \bs0 -> fixUpEOS $ Right (EvPos StreamStart initPos) : (go0 $ filter (not . isWhite) $ Y.tokenize bs0 False)
parseEvents = \bs0 -> fixUpEOS $ Right (EvPos StreamStart initPos) : (go0 $ removeNoise $ Y.tokenize bs0 False)
where
isTCode tc = (== tc) . Y.tCode
skipPast tc (t : ts)
| isTCode tc t = ts
| otherwise = skipPast tc ts
skipPast _ [] = error "the impossible happened"

-- removeNoise
removeNoise = removeRegularBreak . filter (not . isWhite)

-- non-content whitespace
isWhite :: Y.Token -> Bool
isWhite (Y.Token { Y.tCode = Y.Bom }) = True -- BOMs can occur at each doc-start!
isWhite (Y.Token { Y.tCode = Y.White }) = True
isWhite (Y.Token { Y.tCode = Y.Indent }) = True
isWhite (Y.Token { Y.tCode = Y.Break }) = True
isWhite _ = False

-- non-content break
removeRegularBreak :: [Y.Token] -> [Y.Token]
removeRegularBreak [] = []
removeRegularBreak (Y.Token { Y.tCode = Y.Break } : [email protected] { Y.tCode = Y.Break } : xs) = x : removeRegularBreak xs
removeRegularBreak (Y.Token { Y.tCode = Y.Break } : xs) = removeRegularBreak xs
removeRegularBreak (x : xs) = x : removeRegularBreak xs

go0 :: Tok2EvStream
go0 [] = [Right (EvPos StreamEnd initPos {- fixed up by fixUpEOS -} )]
Expand Down Expand Up @@ -445,6 +453,7 @@ goNode0 DInfo {..} = goNode

goPairEnd toks0@(Y.Token { Y.tCode = Y.BeginComment} : _) cont = goComment toks0 (flip goPairEnd cont)
goPairEnd (Y.Token { Y.tCode = Y.EndPair } : rest) cont = cont rest
goPairEnd (tok@(Y.Token { Y.tCode = Y.Break }) : rest) cont = Right (getEvPos EmptyLine tok) : goPairEnd rest cont
goPairEnd xs _cont = err xs


Expand Down
2 changes: 2 additions & 0 deletions src/Data/YAML/Event/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,7 @@ import Util
data Event
= StreamStart
| StreamEnd
| EmptyLine
| DocumentStart !Directives
| DocumentEnd !Bool
| Comment !Text
Expand All @@ -67,6 +68,7 @@ data Event
instance NFData Event where
rnf StreamStart = ()
rnf StreamEnd = ()
rnf EmptyLine = ()
rnf (DocumentStart _) = ()
rnf (DocumentEnd _) = ()
rnf (Comment _) = ()
Expand Down
2 changes: 2 additions & 0 deletions src/Data/YAML/Event/Writer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -152,6 +152,7 @@ putNode = \docMarker -> go (-1 :: Int) (not docMarker) BlockIn
MappingStart anc tag sty -> goMap (n+1) sol (chn sty) anc tag sty rest cont
Alias a -> pfx <> goAlias c a (cont rest)
Comment com -> goComment (n+1) sol c com (go n sol c rest cont)
EmptyLine -> "\n" <> go n sol c rest cont
_ -> error ("putNode: expected node-start event instead of " ++ show t)

where
Expand All @@ -178,6 +179,7 @@ putNode = \docMarker -> go (-1 :: Int) (not docMarker) BlockIn
g' (MappingEnd : rest) = cont rest -- All comments should be part of the key
g' ys = pfx <> putKey ys putValue'

g (EmptyLine : rest) = "\n" <> g rest
g (Comment com: rest) = goComment n True c' com (g rest) -- For trailing comments
g (MappingEnd : rest) = cont rest
g ys = pfx <> putKey ys putValue'
Expand Down