Codebase list haskell-hsyaml / 95ba282
Additional feature to preserve Literal/Folded ScalarStyle vijayphoenix 4 years ago
4 changed file(s) with 65 addition(s) and 40 deletion(s). Raw diff Collapse all Expand all
+14
-4
src/Data/YAML/Event/Internal.hs less more
88 , Event(..)
99 , Directives(..)
1010 , ScalarStyle(..)
11 , Chomp(..)
12 , IndentOfs(..)
1113 , NodeStyle(..)
1214 , scalarNodeStyle
1315 , Tag(..), untagged, isUntagged, tagToText
7173 data ScalarStyle = Plain
7274 | SingleQuoted
7375 | DoubleQuoted
74 | Literal
75 | Folded
76 | Literal !Chomp !IndentOfs
77 | Folded !Chomp !IndentOfs
7678 deriving (Eq,Ord,Show)
79
80 data Chomp = Strip -- ^ Remove all trailing line breaks.
81 | Clip -- ^ Keep first trailing line break.
82 | Keep -- ^ Keep all trailing line breaks.
83 deriving (Eq,Ord,Show)
84
85 data IndentOfs = IndentAuto | IndentOfs1 | IndentOfs2 | IndentOfs3 | IndentOfs4 | IndentOfs5 | IndentOfs6 | IndentOfs7 | IndentOfs8 | IndentOfs9
86 deriving (Eq, Ord, Show, Enum)
7787
7888 -- | Node style
7989 --
8999 scalarNodeStyle Plain = Flow
90100 scalarNodeStyle SingleQuoted = Flow
91101 scalarNodeStyle DoubleQuoted = Flow
92 scalarNodeStyle Literal = Block
93 scalarNodeStyle Folded = Block
102 scalarNodeStyle (Literal _ _) = Block
103 scalarNodeStyle (Folded _ _ ) = Block
94104
95105 -- | YAML Anchor identifiers
96106 type Anchor = Text
+36
-28
src/Data/YAML/Event/Writer.hs less more
128128 Alias a -> pfx <> goAlias c a (cont rest)
129129
130130 _ -> error ("putNode: expected node-start event instead of " ++ show t)
131 where
131 where -- TODO flow
132132 pfx | sol = mempty
133133 | BlockKey <- c = mempty
134134 | otherwise = T.B.singleton ' '
191191
192192 Plain -- empty scalars
193193 | t == "", Nothing <- anc, Tag Nothing <- tag -> contEol -- not even node properties
194 | sol, t == "" -> anchorTag0 anc tag (if c == BlockKey then ws <> cont else contEol)
195 | t == "", BlockKey <- c -> anchorTag0 anc tag (if c == BlockKey then ws <> cont else contEol)
194 | sol, t == "" -> anchorTag0 anc tag (if c == BlockKey then ws <> cont else contEol)
195 | t == "", BlockKey <- c -> anchorTag0 anc tag (if c == BlockKey then ws <> cont else contEol) -- unnecessary if
196196 | t == "" -> anchorTag'' (Left ws) anc tag contEol
197197
198198 Plain -> pfx $
207207
208208 DoubleQuoted -> pfx $ T.B.singleton '"' <> T.B.fromText (escapeDQ t) <> T.B.singleton '"' <> contEol
209209
210 -- block-style
211 Folded --- FIXME/TODO: T.lines eats trailing whitespace; check this works out properly!
212 | T.null t -> pfx $ ">" <> eol <> cont
213 | hasLeadSpace t -> pfx $ (if T.last t == '\n' then ">2" else ">2-") <> g (insFoldNls' $ T.lines t) cont
214 | T.last t == '\n' -> pfx $ T.B.singleton '>' <> g (insFoldNls' $ T.lines t) cont
215 | otherwise -> pfx $ ">-" <> g (insFoldNls' $ T.lines t) cont
216
217 Literal -- TODO: indent-indicator for leading space payloads
218 | T.null t -> pfx $ "|" <> eol <> cont
219 | "\n" == t -> pfx $ "|+" <> g (T.lines t) cont
220 | hasLeadSpace t -> pfx $ "|2" <> g (T.lines t) cont
221 | "\n\n" `T.isSuffixOf` t -> pfx $ "|+" <> g (T.lines t) cont
222 | "\n" `T.isSuffixOf` t -> pfx $ T.B.singleton '|' <> g (T.lines t) cont
223 | otherwise -> pfx $ "|-" <> g (T.lines t) cont
224
225 where
226 hasLeadSpace t' = T.isPrefixOf " " . T.dropWhile (== '\n') $ t'
210 -- block style
211 Folded chm iden -> pfx $ ">" <> goChomp chm <> goDigit iden <> g (insFoldNls' $ T.lines t) (fromEnum iden) cont
212
213 Literal chm iden -> pfx $ "|" <> goChomp chm <> goDigit iden <> g (T.lines t) (fromEnum iden) cont
214
215 where
216 goDigit iden = let ch = C.intToDigit.fromEnum $ iden
217 in if(ch == '0') then mempty else T.B.singleton ch
218
219 goChomp chm = case chm of
220 Strip -> T.B.singleton '-'
221 Clip -> mempty
222 Keep -> T.B.singleton '+'
227223
228224 pfx cont' = (if sol || c == BlockKey then mempty else ws) <> anchorTag'' (Right ws) anc tag cont'
229225
235231 | doEol = eol <> cont
236232 | otherwise = cont
237233
238 g [] cont' = eol <> cont'
239 g (x:xs) cont'
240 | T.null x = eol <> g xs cont'
241 | otherwise = eol <> mkInd n <> T.B.fromText x <> g xs cont'
234 g [] _ cont' = eol <> cont'
235 g (x:xs) dig cont'
236 | T.null x = eol <> g xs dig cont'
237 | dig == 0 = eol <> mkInd (n) <> T.B.fromText x <> g xs dig cont'
238 | otherwise = eol <> mkInd (n-1) <> mkInd' dig <> T.B.fromText x <> g xs dig cont'
242239
243240 g' [] cont' = cont'
244241 g' (x:xs) cont' = eol <> mkInd (n+1) <> T.B.fromText x <> g' xs cont'
250247
251248
252249 isSmallKey (Alias _ : _) = True
253 isSmallKey (Scalar _ _ Folded _ : _) = False
254 isSmallKey (Scalar _ _ Literal _ : _) = False
250 isSmallKey (Scalar _ _ (Folded _ _) _: _) = False
251 isSmallKey (Scalar _ _ (Literal _ _) _: _) = False
255252 isSmallKey (Scalar _ _ _ _ : _) = True
256253 isSmallKey (SequenceStart _ _ _ : _) = False
257254 isSmallKey (MappingStart _ _ _ : _) = False
289286 | l < 0 = error (show l)
290287 | otherwise = T.B.fromText (T.replicate l " ")
291288
289 mkInd' 0 = mempty
290 mkInd' 1 = " "
291 mkInd' 2 = " "
292 mkInd' 3 = " "
293 mkInd' 4 = " "
294 mkInd' 5 = " "
295 mkInd' 6 = " "
296 mkInd' 7 = " "
297 mkInd' 8 = " "
298 mkInd' 9 = " "
299 mkInd' l = error ("Impossible Indentation-level" ++ show l)
292300
293301 eol = T.B.singleton '\n'
294302 ws = T.B.singleton ' '
341349 -- FIXME: check single-quoted strings with leading '\n' or trailing '\n's
342350 insFoldNls :: [Text] -> [Text]
343351 insFoldNls [] = []
344 insFoldNls (z:zs)
345 | all T.null (z:zs) = "" : z : zs -- HACK
352 insFoldNls z0@(z:zs)
353 | all T.null z0 = "" : z0 -- HACK
346354 | otherwise = z : go zs
347355 where
348356 go [] = []
+13
-6
src/Data/YAML/Event.hs less more
285285 go0 ii sty (Y.Token { Y.tCode = Y.Indicator, Y.tText = ind } : rest)
286286 | "'" <- ind = go' ii "" SingleQuoted rest
287287 | "\"" <- ind = go' ii "" DoubleQuoted rest
288 | "|" <- ind = go0 True Literal rest
289 | ">" <- ind = go0 True Folded rest
290
291 | "+" <- ind = go0 ii sty rest
292 | "-" <- ind = go0 ii sty rest
293 | [c] <- ind, '1' <= c, c <= '9' = go0 False sty rest
288 | "|" <- ind = go0 True (Literal Clip (toEnum 0)) rest
289 | ">" <- ind = go0 True (Folded Clip (toEnum 0)) rest
290
291 | "+" <- ind = go0 ii (chn sty Keep) rest
292 | "-" <- ind = go0 ii (chn sty Strip) rest
293 | [c] <- ind, '1' <= c, c <= '9' = go0 False (chn' sty (C.digitToInt c)) rest
294294
295295 go0 ii sty (Y.Token { Y.tCode = Y.Text, Y.tText = t } : rest) = go' ii t sty rest
296296 go0 ii sty (Y.Token { Y.tCode = Y.LineFold } : rest) = go' ii " " sty rest
298298 go0 _ sty (Y.Token { Y.tCode = Y.EndScalar } : rest) = Right (Scalar manchor tag sty mempty) : cont rest
299299
300300 go0 _ _ xs = err xs
301
302 chn (Literal _ digit) chmp = Literal chmp digit
303 chn (Folded _ digit) chmp = Folded chmp digit
304 chn _ _ = error "impossible"
305 chn' (Literal b _) digit = Literal b (toEnum digit)
306 chn' (Folded b _) digit = Folded b (toEnum digit)
307 chn' _ _ = error "impossible"
301308
302309 ----------------------------------------------------------------------------
303310
+2
-2
src-test/Main.hs less more
461461 styStr = \case
462462 Plain -> " :"
463463 DoubleQuoted -> " \""
464 Literal -> " |"
465 Folded -> " >"
464 Literal _ _ -> " |"
465 Folded _ _ -> " >"
466466 SingleQuoted -> " '"
467467
468468 ancTagStr manc mtag = anc' ++ tag'