Add EmptyLine Event

This change adds rudimentary support for preserving empty lines.

Fixes: haskell-hvr#48

src/Data/YAML/Event.hs

@@ -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 } : x@Y.Token { 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 -} )]
@@ -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
 
 

src/Data/YAML/Event/Internal.hs

@@ -52,6 +52,7 @@ import           Util
 data Event
     = StreamStart
     | StreamEnd
+    | EmptyLine
     | DocumentStart  !Directives
     | DocumentEnd    !Bool
     | Comment        !Text
@@ -67,6 +68,7 @@ data Event
 instance NFData Event where
   rnf  StreamStart          = ()
   rnf  StreamEnd            = ()
+  rnf  EmptyLine            = ()
   rnf (DocumentStart _)     = ()
   rnf (DocumentEnd _)       = ()
   rnf (Comment _)           = ()

src/Data/YAML/Event/Writer.hs

@@ -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
@@ -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'