{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
module Data.YAML.Event.Writer
( writeEvents
, writeEventsText
) where
import Data.YAML.Event.Internal
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.Char as C
import qualified Data.Map as Map
import qualified Data.Text as T
import Text.Printf (printf)
import qualified Data.Text.Lazy as T.L
import qualified Data.Text.Lazy.Builder as T.B
import qualified Data.Text.Lazy.Encoding as T.L
import Util
writeEvents :: Encoding -> [Event] -> BS.L.ByteString
writeEvents :: Encoding -> [Event] -> ByteString
writeEvents Encoding
UTF8 = Text -> ByteString
T.L.encodeUtf8 (Text -> ByteString) -> ([Event] -> Text) -> [Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
writeEventsText
writeEvents Encoding
UTF16LE = Text -> ByteString
T.L.encodeUtf16LE (Text -> ByteString) -> ([Event] -> Text) -> [Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.L.cons Char
'\xfeff' (Text -> Text) -> ([Event] -> Text) -> [Event] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
writeEventsText
writeEvents Encoding
UTF16BE = Text -> ByteString
T.L.encodeUtf16BE (Text -> ByteString) -> ([Event] -> Text) -> [Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.L.cons Char
'\xfeff' (Text -> Text) -> ([Event] -> Text) -> [Event] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
writeEventsText
writeEvents Encoding
UTF32LE = Text -> ByteString
T.L.encodeUtf32LE (Text -> ByteString) -> ([Event] -> Text) -> [Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.L.cons Char
'\xfeff' (Text -> Text) -> ([Event] -> Text) -> [Event] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
writeEventsText
writeEvents Encoding
UTF32BE = Text -> ByteString
T.L.encodeUtf32BE (Text -> ByteString) -> ([Event] -> Text) -> [Event] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.L.cons Char
'\xfeff' (Text -> Text) -> ([Event] -> Text) -> [Event] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Text
writeEventsText
writeEventsText :: [Event] -> T.L.Text
writeEventsText :: [Event] -> Text
writeEventsText [] = Text
forall a. Monoid a => a
mempty
writeEventsText (Event
StreamStart:[Event]
xs) = Builder -> Text
T.B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Event] -> Any -> Builder
forall t. [Event] -> t -> Builder
goStream [Event]
xs ([Char] -> Any
forall a. HasCallStack => [Char] -> a
error [Char]
"writeEvents: internal error")
where
goStream :: [Event] -> t -> Builder
goStream [Event
StreamEnd] t
_ = Builder
forall a. Monoid a => a
mempty
goStream (Event
StreamEnd : Event
_ : [Event]
_ ) t
_cont = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"writeEvents: events after StreamEnd"
goStream (Comment Text
com: [Event]
rest) t
cont = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment (Int
0 :: Int) Bool
True Context
BlockIn Text
com ([Event] -> t -> Builder
goStream [Event]
rest t
cont)
goStream (DocumentStart Directives
marker : [Event]
rest) t
cont
= case Directives
marker of
Directives
NoDirEndMarker -> Bool -> [Event] -> ([Event] -> Builder) -> Builder
putNode Bool
False [Event]
rest (\[Event]
zs -> [Event] -> t -> Builder
goDoc [Event]
zs t
cont)
Directives
DirEndMarkerNoVersion -> Builder
"---" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [Event] -> ([Event] -> Builder) -> Builder
putNode Bool
True [Event]
rest (\[Event]
zs -> [Event] -> t -> Builder
goDoc [Event]
zs t
cont)
DirEndMarkerVersion Word
mi -> Builder
"%YAML 1." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Builder
T.B.fromString (Word -> [Char]
forall a. Show a => a -> [Char]
show Word
mi)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n---" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [Event] -> ([Event] -> Builder) -> Builder
putNode Bool
True [Event]
rest (\[Event]
zs -> [Event] -> t -> Builder
goDoc [Event]
zs t
cont)
goStream (Event
x:[Event]
_) t
_cont = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"writeEvents: unexpected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (expected DocumentStart or StreamEnd)")
goStream [] t
_cont = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"writeEvents: unexpected end of stream (expected DocumentStart or StreamEnd)")
goDoc :: [Event] -> t -> Builder
goDoc (DocumentEnd Bool
marker : [Event]
rest) t
cont
= (if Bool
marker then Builder
"...\n" else Builder
forall a. Monoid a => a
mempty) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> t -> Builder
goStream [Event]
rest t
cont
goDoc (Comment Text
com: [Event]
rest) t
cont = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment (Int
0 :: Int) Bool
True Context
BlockIn Text
com ([Event] -> t -> Builder
goDoc [Event]
rest t
cont)
goDoc [Event]
ys t
_ = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Event] -> [Char]
forall a. Show a => a -> [Char]
show [Event]
ys)
writeEventsText (Event
x:[Event]
_) = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"writeEvents: unexpected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (expected StreamStart)")
data Context = BlockOut
| BlockIn
| BlockKey
| FlowOut
| FlowIn
| FlowKey
deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq,Int -> Context -> [Char] -> [Char]
[Context] -> [Char] -> [Char]
Context -> [Char]
(Int -> Context -> [Char] -> [Char])
-> (Context -> [Char])
-> ([Context] -> [Char] -> [Char])
-> Show Context
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Context] -> [Char] -> [Char]
$cshowList :: [Context] -> [Char] -> [Char]
show :: Context -> [Char]
$cshow :: Context -> [Char]
showsPrec :: Int -> Context -> [Char] -> [Char]
$cshowsPrec :: Int -> Context -> [Char] -> [Char]
Show)
goComment :: Int -> Bool -> Context -> T.Text -> T.B.Builder -> T.B.Builder
!Int
n !Bool
sol Context
c Text
comment Builder
cont = Builder
doSol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"#" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
T.B.fromText Text
comment) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doIndent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
where
doEol :: Builder
doEol
| Bool -> Bool
not Bool
sol Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Builder
forall a. Monoid a => a
mempty
| Bool
sol Bool -> Bool -> Bool
&& Context
FlowIn Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = Builder
eol
doSol :: Builder
doSol
| Bool -> Bool
not Bool
sol Bool -> Bool -> Bool
&& (Context
BlockOut Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c Bool -> Bool -> Bool
|| Context
FlowOut Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c) = Builder
ws
| Bool
sol = Int -> Builder
mkInd Int
n'
| Bool
otherwise = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n'
n' :: Int
n'
| Context
BlockOut <- Context
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Context
FlowOut <- Context
c = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
n
doIndent :: Builder
doIndent
| Context
BlockOut <- Context
c = Int -> Builder
mkInd Int
n'
| Context
FlowOut <- Context
c = Int -> Builder
mkInd Int
n'
| Bool
otherwise = Builder
forall a. Monoid a => a
mempty
putNode :: Bool -> [Event] -> ([Event] -> T.B.Builder) -> T.B.Builder
putNode :: Bool -> [Event] -> ([Event] -> Builder) -> Builder
putNode = \Bool
docMarker -> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go (-Int
1 :: Int) (Bool -> Bool
not Bool
docMarker) Context
BlockIn
where
go :: Int -> Bool -> Context -> [Event] -> ([Event] -> T.B.Builder) -> T.B.Builder
go :: Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
_ Bool
_ Context
_ [] [Event] -> Builder
_cont = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"putNode: expected node-start event instead of end-of-stream")
go !Int
n !Bool
sol Context
c (Event
t : [Event]
rest) [Event] -> Builder
cont = case Event
t of
Scalar Maybe Text
anc Tag
tag ScalarStyle
sty Text
t' -> Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> ScalarStyle
-> Text
-> Builder
-> Builder
goStr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
sol Context
c Maybe Text
anc Tag
tag ScalarStyle
sty Text
t' ([Event] -> Builder
cont [Event]
rest)
SequenceStart Maybe Text
anc Tag
tag NodeStyle
sty -> Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> NodeStyle
-> [Event]
-> ([Event] -> Builder)
-> Builder
goSeq (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
sol (NodeStyle -> Context
chn NodeStyle
sty) Maybe Text
anc Tag
tag NodeStyle
sty [Event]
rest [Event] -> Builder
cont
MappingStart Maybe Text
anc Tag
tag NodeStyle
sty -> Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> NodeStyle
-> [Event]
-> ([Event] -> Builder)
-> Builder
goMap (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
sol (NodeStyle -> Context
chn NodeStyle
sty) Maybe Text
anc Tag
tag NodeStyle
sty [Event]
rest [Event] -> Builder
cont
Alias Text
a -> Builder
pfx Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Context -> Text -> Builder -> Builder
goAlias Context
c Text
a ([Event] -> Builder
cont [Event]
rest)
Comment Text
com -> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
sol Context
c Text
com (Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n Bool
sol Context
c [Event]
rest [Event] -> Builder
cont)
Event
_ -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"putNode: expected node-start event instead of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
t)
where
pfx :: Builder
pfx | Bool
sol = Builder
forall a. Monoid a => a
mempty
| Context
BlockKey <- Context
c = Builder
forall a. Monoid a => a
mempty
| Context
FlowKey <- Context
c = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = Char -> Builder
T.B.singleton Char
' '
chn :: NodeStyle -> Context
chn NodeStyle
sty
| NodeStyle
Flow <-NodeStyle
sty, (Context
BlockIn Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c Bool -> Bool -> Bool
|| Context
BlockOut Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c) = Context
FlowOut
| Bool
otherwise = Context
c
goMap :: Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> NodeStyle
-> [Event]
-> ([Event] -> Builder)
-> Builder
goMap Int
_ Bool
sol Context
_ Maybe Text
anc Tag
tag NodeStyle
_ (Event
MappingEnd : [Event]
rest) [Event] -> Builder
cont = Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
"{}\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
where
pfx :: Builder -> Builder
pfx Builder
cont' = Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right Builder
ws) Maybe Text
anc Tag
tag Builder
cont'
goMap Int
n Bool
sol Context
c Maybe Text
anc Tag
tag NodeStyle
Block [Event]
xs [Event] -> Builder
cont = case Context
c of
Context
BlockIn | Bool -> Bool
not (Bool -> Bool
not Bool
sol Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
-> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right (Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n)) Maybe Text
anc Tag
tag
([Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
xs [Event] -> Builder
putValue')
Context
_ -> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. a -> Either a b
Left Builder
ws) Maybe Text
anc Tag
tag (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
g' [Event]
xs
where
g' :: [Event] -> Builder
g' (Event
MappingEnd : [Event]
rest) = [Event] -> Builder
cont [Event]
rest
g' [Event]
ys = Builder
pfx Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
ys [Event] -> Builder
putValue'
g :: [Event] -> Builder
g (Comment Text
com: [Event]
rest) = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n Bool
True Context
c' Text
com ([Event] -> Builder
g [Event]
rest)
g (Event
MappingEnd : [Event]
rest) = [Event] -> Builder
cont [Event]
rest
g [Event]
ys = Builder
pfx Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
ys [Event] -> Builder
putValue'
pfx :: Builder
pfx = if Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
BlockIn Bool -> Bool -> Bool
|| Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
BlockOut Bool -> Bool -> Bool
|| Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
BlockKey then Int -> Builder
mkInd Int
n else Builder
ws
c' :: Context
c' = if Context
FlowIn Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c then Context
FlowKey else Context
BlockKey
doEol :: Builder
doEol = case Context
c of
Context
FlowKey -> Builder
forall a. Monoid a => a
mempty
Context
FlowIn -> Builder
forall a. Monoid a => a
mempty
Context
_ -> Builder
eol
putKey :: [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
zs [Event] -> Builder
cont2
| [Event] -> Bool
isSmallKey [Event]
zs = Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Context
c' [Event]
zs (\[Event]
ys -> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont2 [Event]
ys)
| Comment Text
com: [Event]
rest <- [Event]
zs = Builder
"?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
0 Bool
True Context
BlockIn Text
com ([Event] -> ([Event] -> Builder) -> Builder
f [Event]
rest [Event] -> Builder
cont2)
| Bool
otherwise = Builder
"?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n Bool
False Context
BlockIn [Event]
zs (([Event] -> Builder) -> [Event] -> Builder
forall t. (t -> Builder) -> t -> Builder
putValue [Event] -> Builder
cont2)
f :: [Event] -> ([Event] -> Builder) -> Builder
f (Comment Text
com: [Event]
rest) [Event] -> Builder
cont2 = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
True Context
BlockIn Text
com ([Event] -> ([Event] -> Builder) -> Builder
f [Event]
rest [Event] -> Builder
cont2)
f [Event]
zs [Event] -> Builder
cont2 = Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n Bool
False Context
BlockIn [Event]
zs (([Event] -> Builder) -> [Event] -> Builder
forall t. (t -> Builder) -> t -> Builder
putValue [Event] -> Builder
cont2)
putValue :: (t -> Builder) -> t -> Builder
putValue t -> Builder
cont2 t
zs
| Context
FlowIn <- Context
c = Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
cont2 t
zs
| Bool
otherwise = Int -> Builder
mkInd Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
cont2 t
zs
putValue' :: [Event] -> Builder
putValue' (Comment Text
com: [Event]
rest) = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool
False Context
BlockOut Text
com (Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
putValue' [Event]
rest)
putValue' [Event]
zs = Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n Bool
False (if Context
FlowIn Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
c then Context
FlowIn else Context
BlockOut) [Event]
zs [Event] -> Builder
g
goMap Int
n Bool
sol Context
c Maybe Text
anc Tag
tag NodeStyle
Flow [Event]
xs [Event] -> Builder
cont =
Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right Builder
ws) Maybe Text
anc Tag
tag (Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
f [Event]
xs)
where
f :: [Event] -> Builder
f (Comment Text
com: [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True (Context -> Context
inFlow Context
c) Text
com ([Event] -> Builder
f [Event]
rest)
f (Event
MappingEnd : [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
f [Event]
ys = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
ys [Event] -> Builder
putValue'
n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
doEol :: Builder
doEol = case Context
c of
Context
FlowKey -> Builder
forall a. Monoid a => a
mempty
Context
FlowIn -> Builder
forall a. Monoid a => a
mempty
Context
_ -> Builder
eol
g :: [Event] -> Builder
g (Comment Text
com: [Event]
rest) = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True (Context -> Context
inFlow Context
c) Text
com ([Event] -> Builder
f [Event]
rest)
g (Event
MappingEnd : [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
g [Event]
ys = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
ys [Event] -> Builder
putValue'
putKey :: [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
zs [Event] -> Builder
cont2
| (Comment Text
com: [Event]
rest) <- [Event]
zs = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True Context
c Text
com (Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> ([Event] -> Builder) -> Builder
putKey [Event]
rest [Event] -> Builder
cont2)
| [Event] -> Bool
isSmallKey [Event]
zs = Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Context
FlowKey [Event]
zs (if [Event] -> Bool
isComEv [Event]
zs then ([Event] -> Builder) -> [Event] -> Builder
putValue [Event] -> Builder
cont2 else (\[Event]
ys -> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont2 [Event]
ys))
| Bool
otherwise = Builder
"?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n Bool
False Context
FlowIn [Event]
zs (([Event] -> Builder) -> [Event] -> Builder
putValue [Event] -> Builder
cont2)
putValue :: ([Event] -> Builder) -> [Event] -> Builder
putValue [Event] -> Builder
cont2 [Event]
zs
| Comment Text
com: [Event]
rest <- [Event]
zs = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True (Context -> Context
inFlow Context
c) Text
com (([Event] -> Builder) -> [Event] -> Builder
putValue [Event] -> Builder
cont2 [Event]
rest)
| Bool
otherwise = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont2 [Event]
zs
putValue' :: [Event] -> Builder
putValue' [Event]
zs
| Comment Text
com : [Event]
rest <- [Event]
zs = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
False Context
FlowOut Text
com ([Event] -> Builder
putValue' [Event]
rest)
| Bool
otherwise = Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False Context
FlowIn [Event]
zs [Event] -> Builder
g
goSeq :: Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> NodeStyle
-> [Event]
-> ([Event] -> Builder)
-> Builder
goSeq Int
_ Bool
sol Context
_ Maybe Text
anc Tag
tag NodeStyle
_ (Event
SequenceEnd : [Event]
rest) [Event] -> Builder
cont = Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
"[]\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
where
pfx :: Builder -> Builder
pfx Builder
cont' = Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right Builder
ws) Maybe Text
anc Tag
tag Builder
cont'
goSeq Int
n Bool
sol Context
c Maybe Text
anc Tag
tag NodeStyle
Block [Event]
xs [Event] -> Builder
cont = case Context
c of
Context
BlockOut -> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. a -> Either a b
Left Builder
ws) Maybe Text
anc Tag
tag (Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if [Event] -> Bool
isComEv [Event]
xs then Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
f [Event]
xs else [Event] -> Builder
g [Event]
xs)
Context
BlockIn
| Bool -> Bool
not Bool
sol Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> NodeStyle
-> [Event]
-> ([Event] -> Builder)
-> Builder
goSeq Int
n Bool
sol Context
BlockOut Maybe Text
anc Tag
tag NodeStyle
Block [Event]
xs [Event] -> Builder
cont
| Comment Text
com: [Event]
rest <- [Event]
xs -> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right (Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n')) Maybe Text
anc Tag
tag (Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
0 Bool
True Context
BlockIn Text
com ([Event] -> Builder
f [Event]
rest))
| Bool
otherwise -> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right (Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n')) Maybe Text
anc Tag
tag (Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False Context
BlockIn [Event]
xs [Event] -> Builder
g)
Context
BlockKey -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"sequence in block-key context not supported"
Context
_ -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid Context in Block style"
where
n' :: Int
n' | Context
BlockOut <- Context
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = Int
n
g :: [Event] -> Builder
g (Comment Text
com: [Event]
rest) = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True Context
BlockIn Text
com ([Event] -> Builder
g [Event]
rest)
g (Event
SequenceEnd : [Event]
rest) = [Event] -> Builder
cont [Event]
rest
g [Event]
ys = Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False Context
BlockIn [Event]
ys [Event] -> Builder
g
f :: [Event] -> Builder
f (Comment Text
com: [Event]
rest) = Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True Context
BlockIn Text
com ([Event] -> Builder
f [Event]
rest)
f (Event
SequenceEnd : [Event]
rest) = [Event] -> Builder
cont [Event]
rest
f [Event]
ys = Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False Context
BlockIn [Event]
ys [Event] -> Builder
g
goSeq Int
n Bool
sol Context
c Maybe Text
anc Tag
tag NodeStyle
Flow [Event]
xs [Event] -> Builder
cont =
Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right Builder
ws) Maybe Text
anc Tag
tag (Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
f [Event]
xs)
where
f :: [Event] -> Builder
f (Comment Text
com: [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True (Context -> Context
inFlow Context
c) Text
com ([Event] -> Builder
f [Event]
rest)
f (Event
SequenceEnd : [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
f [Event]
ys = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False (Context -> Context
inFlow Context
c) [Event]
ys [Event] -> Builder
g
n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
doEol :: Builder
doEol = case Context
c of
Context
FlowKey -> Builder
forall a. Monoid a => a
mempty
Context
FlowIn -> Builder
forall a. Monoid a => a
mempty
Context
_ -> Builder
eol
g :: [Event] -> Builder
g (Comment Text
com: [Event]
rest) = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Bool -> Context -> Text -> Builder -> Builder
goComment Int
n' Bool
True (Context -> Context
inFlow Context
c) Text
com ([Event] -> Builder
f [Event]
rest)
g (Event
SequenceEnd : [Event]
rest) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Builder
wsSol Bool
sol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
doEol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Event] -> Builder
cont [Event]
rest
g [Event]
ys = Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd Int
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int
-> Bool -> Context -> [Event] -> ([Event] -> Builder) -> Builder
go Int
n' Bool
False (Context -> Context
inFlow Context
c) [Event]
ys [Event] -> Builder
g
goAlias :: Context -> Text -> Builder -> Builder
goAlias Context
c Text
a Builder
cont = Char -> Builder
T.B.singleton Char
'*' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sep Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
where
sep :: Builder
sep = case Context
c of
Context
BlockIn -> Builder
eol
Context
BlockOut -> Builder
eol
Context
BlockKey -> Char -> Builder
T.B.singleton Char
' '
Context
FlowIn -> Builder
forall a. Monoid a => a
mempty
Context
FlowOut -> Builder
eol
Context
FlowKey -> Char -> Builder
T.B.singleton Char
' '
goStr :: Int -> Bool -> Context -> Maybe Anchor -> Tag -> ScalarStyle -> Text -> T.B.Builder -> T.B.Builder
goStr :: Int
-> Bool
-> Context
-> Maybe Text
-> Tag
-> ScalarStyle
-> Text
-> Builder
-> Builder
goStr !Int
n !Bool
sol Context
c Maybe Text
anc Tag
tag ScalarStyle
sty Text
t Builder
cont = case ScalarStyle
sty of
ScalarStyle
Plain
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" -> case () of
()
_ | Maybe Text
Nothing <- Maybe Text
anc, Tag Maybe Text
Nothing <- Tag
tag -> Builder
contEol
| Bool
sol -> Maybe Text -> Tag -> Builder -> Builder
anchorTag0 Maybe Text
anc Tag
tag (if Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
BlockKey Bool -> Bool -> Bool
|| Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
FlowKey then Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont else Builder
contEol)
| Context
BlockKey <- Context
c -> Maybe Text -> Tag -> Builder -> Builder
anchorTag0 Maybe Text
anc Tag
tag (Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont)
| Context
FlowKey <- Context
c -> Maybe Text -> Tag -> Builder -> Builder
anchorTag0 Maybe Text
anc Tag
tag (Builder
ws Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont)
| Bool
otherwise -> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. a -> Either a b
Left Builder
ws) Maybe Text
anc Tag
tag Builder
contEol
ScalarStyle
Plain -> Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
let h :: [Text] -> Builder
h [] = Builder
contEol
h (Text
x:[Text]
xs) = Text -> Builder
T.B.fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
f' [Text]
xs
where
f' :: [Text] -> Builder
f' [] = Builder
contEol
f' (Text
y:[Text]
ys) = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
y Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder
f' [Text]
ys
in [Text] -> Builder
h ([Text] -> [Text]
insFoldNls (Text -> [Text]
T.lines Text
t))
ScalarStyle
SingleQuoted -> Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> Builder
T.B.singleton Char
'\'' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder -> Builder
f ([Text] -> [Text]
insFoldNls ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> Text -> Text -> Text
T.replace Text
"'" Text
"''" Text
t) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
forall a. Monoid a => a
mempty | Text -> Text -> Bool
T.isSuffixOf Text
"\n" Text
t]) (Char -> Builder
T.B.singleton Char
'\'' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contEol)
ScalarStyle
DoubleQuoted -> Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> Builder
T.B.singleton Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText (Text -> Text
escapeDQ Text
t) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contEol
Folded Chomp
chm IndentOfs
iden -> Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Chomp -> Builder
goChomp Chomp
chm Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IndentOfs -> Builder
goDigit IndentOfs
iden Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Int -> Builder -> Builder
g ([Text] -> [Text]
insFoldNls' ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t) (IndentOfs -> Int
forall a. Enum a => a -> Int
fromEnum IndentOfs
iden) Builder
cont
Literal Chomp
chm IndentOfs
iden -> Builder -> Builder
pfx (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
"|" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Chomp -> Builder
goChomp Chomp
chm Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IndentOfs -> Builder
goDigit IndentOfs
iden Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Int -> Builder -> Builder
g (Text -> [Text]
T.lines Text
t) (IndentOfs -> Int
forall a. Enum a => a -> Int
fromEnum IndentOfs
iden) Builder
cont
where
goDigit :: IndentOfs -> T.B.Builder
goDigit :: IndentOfs -> Builder
goDigit IndentOfs
iden = let ch :: Char
ch = Int -> Char
C.intToDigit(Int -> Char) -> (IndentOfs -> Int) -> IndentOfs -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IndentOfs -> Int
forall a. Enum a => a -> Int
fromEnum (IndentOfs -> Char) -> IndentOfs -> Char
forall a b. (a -> b) -> a -> b
$ IndentOfs
iden
in if(Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') then Builder
forall a. Monoid a => a
mempty else Char -> Builder
T.B.singleton Char
ch
goChomp :: Chomp -> T.B.Builder
goChomp :: Chomp -> Builder
goChomp Chomp
chm = case Chomp
chm of
Chomp
Strip -> Char -> Builder
T.B.singleton Char
'-'
Chomp
Clip -> Builder
forall a. Monoid a => a
mempty
Chomp
Keep -> Char -> Builder
T.B.singleton Char
'+'
pfx :: Builder -> Builder
pfx Builder
cont' = (if Bool
sol Bool -> Bool -> Bool
|| Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
BlockKey Bool -> Bool -> Bool
|| Context
c Context -> Context -> Bool
forall a. Eq a => a -> a -> Bool
== Context
FlowKey then Builder
forall a. Monoid a => a
mempty else Builder
ws) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. b -> Either a b
Right Builder
ws) Maybe Text
anc Tag
tag Builder
cont'
doEol :: Bool
doEol = case Context
c of
Context
BlockKey -> Bool
False
Context
FlowKey -> Bool
False
Context
FlowIn -> Bool
False
Context
_ -> Bool
True
contEol :: Builder
contEol
| Bool
doEol = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
| Bool
otherwise = Builder
cont
g :: [Text] -> Int -> Builder -> Builder
g [] Int
_ Builder
cont' = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont'
g (Text
x:[Text]
xs) Int
dig Builder
cont'
| Text -> Bool
T.null Text
x = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Int -> Builder -> Builder
g [Text]
xs Int
dig Builder
cont'
| Int
dig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Builder
mkInd Int
n else Int -> Builder
mkInd' Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Int -> Builder -> Builder
g [Text]
xs Int
dig Builder
cont'
| Bool
otherwise = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd' Int
dig Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Int -> Builder -> Builder
g [Text]
xs Int
dig Builder
cont'
g' :: [Text] -> Builder -> Builder
g' [] Builder
cont' = Builder
cont'
g' (Text
x:[Text]
xs) Builder
cont' = Builder
eol Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
mkInd (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder -> Builder
g' [Text]
xs Builder
cont'
f :: [Text] -> Builder -> Builder
f [] Builder
cont' = Builder
cont'
f (Text
x:[Text]
xs) Builder
cont' = Text -> Builder
T.B.fromText Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Text] -> Builder -> Builder
g' [Text]
xs Builder
cont'
isSmallKey :: [Event] -> Bool
isSmallKey (Alias Text
_ : [Event]
_) = Bool
True
isSmallKey (Scalar Maybe Text
_ Tag
_ (Folded Chomp
_ IndentOfs
_) Text
_: [Event]
_) = Bool
False
isSmallKey (Scalar Maybe Text
_ Tag
_ (Literal Chomp
_ IndentOfs
_) Text
_: [Event]
_) = Bool
False
isSmallKey (Scalar Maybe Text
_ Tag
_ ScalarStyle
_ Text
_ : [Event]
_) = Bool
True
isSmallKey (SequenceStart Maybe Text
_ Tag
_ NodeStyle
_ : [Event]
_) = Bool
False
isSmallKey (MappingStart Maybe Text
_ Tag
_ NodeStyle
_ : [Event]
_) = Bool
False
isSmallKey [Event]
_ = Bool
False
inFlow :: Context -> Context
inFlow Context
c = case Context
c of
Context
FlowIn -> Context
FlowIn
Context
FlowOut -> Context
FlowIn
Context
BlockKey -> Context
FlowKey
Context
FlowKey -> Context
FlowKey
Context
_ -> [Char] -> Context
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid context in Flow style"
putTag :: Text -> Builder -> Builder
putTag Text
t Builder
cont
| Just Text
t' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"tag:yaml.org,2002:" Text
t = Builder
"!!" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
t' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
| Text
"!" Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text -> Builder
T.B.fromText Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
| Bool
otherwise = Builder
"!<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
'>' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
anchorTag'' :: Either T.B.Builder T.B.Builder -> Maybe Anchor -> Tag -> T.B.Builder -> T.B.Builder
anchorTag'' :: Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' Either Builder Builder
_ Maybe Text
Nothing (Tag Maybe Text
Nothing) Builder
cont = Builder
cont
anchorTag'' (Right Builder
pad) Maybe Text
Nothing (Tag (Just Text
t)) Builder
cont = Text -> Builder -> Builder
putTag Text
t (Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont)
anchorTag'' (Right Builder
pad) (Just Text
a) (Tag Maybe Text
Nothing) Builder
cont = Char -> Builder
T.B.singleton Char
'&' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
anchorTag'' (Right Builder
pad) (Just Text
a) (Tag (Just Text
t)) Builder
cont = Char -> Builder
T.B.singleton Char
'&' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder -> Builder
putTag Text
t (Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont)
anchorTag'' (Left Builder
pad) Maybe Text
Nothing (Tag (Just Text
t)) Builder
cont = Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder -> Builder
putTag Text
t Builder
cont
anchorTag'' (Left Builder
pad) (Just Text
a) (Tag Maybe Text
Nothing) Builder
cont = Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
'&' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cont
anchorTag'' (Left Builder
pad) (Just Text
a) (Tag (Just Text
t)) Builder
cont = Builder
pad Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
'&' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.B.fromText Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
T.B.singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder -> Builder
putTag Text
t Builder
cont
anchorTag0 :: Maybe Text -> Tag -> Builder -> Builder
anchorTag0 = Either Builder Builder -> Maybe Text -> Tag -> Builder -> Builder
anchorTag'' (Builder -> Either Builder Builder
forall a b. a -> Either a b
Left Builder
forall a. Monoid a => a
mempty)
isComEv :: [Event] -> Bool
isComEv :: [Event] -> Bool
isComEv (Comment Text
_: [Event]
_) = Bool
True
isComEv [Event]
_ = Bool
False
mkInd :: Int -> T.B.Builder
mkInd :: Int -> Builder
mkInd (-1) = Builder
forall a. Monoid a => a
mempty
mkInd Int
0 = Builder
forall a. Monoid a => a
mempty
mkInd Int
1 = Builder
" "
mkInd Int
2 = Builder
" "
mkInd Int
3 = Builder
" "
mkInd Int
4 = Builder
" "
mkInd Int
l
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l)
| Bool
otherwise = Text -> Builder
T.B.fromText (Int -> Text -> Text
T.replicate Int
l Text
" ")
mkInd' :: Int -> T.B.Builder
mkInd' :: Int -> Builder
mkInd' Int
1 = Builder
" "
mkInd' Int
2 = Builder
" "
mkInd' Int
3 = Builder
" "
mkInd' Int
4 = Builder
" "
mkInd' Int
5 = Builder
" "
mkInd' Int
6 = Builder
" "
mkInd' Int
7 = Builder
" "
mkInd' Int
8 = Builder
" "
mkInd' Int
9 = Builder
" "
mkInd' Int
l = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error ([Char]
"Impossible Indentation-level" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l)
eol, ws:: T.B.Builder
eol :: Builder
eol = Char -> Builder
T.B.singleton Char
'\n'
ws :: Builder
ws = Char -> Builder
T.B.singleton Char
' '
wsSol :: Bool -> T.B.Builder
wsSol :: Bool -> Builder
wsSol Bool
sol = if Bool
sol then Builder
forall a. Monoid a => a
mempty else Builder
ws
escapeDQ :: Text -> Text
escapeDQ :: Text -> Text
escapeDQ Text
t
| (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
C.isPrint Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') Text
t = Text
t
| Bool
otherwise = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
t
escapeChar :: Char -> Text
escapeChar :: Char -> Text
escapeChar Char
c
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = Text
"\\\\"
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = Text
"\\\""
| Char -> Bool
C.isPrint Char
c = Char -> Text
T.singleton Char
c
| Just Text
e <- Char -> Map Char Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c Map Char Text
emap = Text
e
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff = [Char] -> Text
T.pack ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\x%02x" Int
x)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff = [Char] -> Text
T.pack ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\u%04x" Int
x)
| Bool
otherwise = [Char] -> Text
T.pack ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\U%08x" Int
x)
where
x :: Int
x = Char -> Int
ord Char
c
emap :: Map Char Text
emap = [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Char
v,[Char] -> Text
T.pack [Char
'\\',Char
k]) | (Char
k,Char
v) <- [(Char, Char)]
escapes ]
escapes :: [(Char,Char)]
escapes :: [(Char, Char)]
escapes =
[ (Char
'0', Char
'\0')
, (Char
'a', Char
'\x7')
, (Char
'b', Char
'\x8')
, (Char
'\x9', Char
'\x9')
, (Char
't', Char
'\x9')
, (Char
'n', Char
'\xa')
, (Char
'v', Char
'\xb')
, (Char
'f', Char
'\xc')
, (Char
'r', Char
'\xd')
, (Char
'e', Char
'\x1b')
, (Char
' ', Char
' ')
, (Char
'"', Char
'"')
, (Char
'/', Char
'/')
, (Char
'\\', Char
'\\')
, (Char
'N', Char
'\x85')
, (Char
'_', Char
'\xa0')
, (Char
'L', Char
'\x2028')
, (Char
'P', Char
'\x2029')
]
insFoldNls :: [Text] -> [Text]
insFoldNls :: [Text] -> [Text]
insFoldNls [] = []
insFoldNls z0 :: [Text]
z0@(Text
z:[Text]
zs)
| (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
T.null [Text]
z0 = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
z0
| Bool
otherwise = Text
z Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
zs
where
go :: [Text] -> [Text]
go [] = []
go (Text
l:[Text]
ls)
| Text -> Bool
T.null Text
l = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go' [Text]
ls
| Bool
otherwise = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ls
go' :: [Text] -> [Text]
go' [] = [Text
""]
go' (Text
l:[Text]
ls)
| Text -> Bool
T.null Text
l = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go' [Text]
ls
| Bool
otherwise = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ls
insFoldNls' :: [Text] -> [Text]
insFoldNls' :: [Text] -> [Text]
insFoldNls' = [Text] -> [Text]
go'
where
go :: [Text] -> [Text]
go [] = []
go (Text
l:[Text]
ls)
| Text -> Bool
T.null Text
l = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ls
| Char -> Bool
isWhite (Text -> Char
T.head Text
l) = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go' [Text]
ls
| Bool
otherwise = Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ls
go' :: [Text] -> [Text]
go' [] = []
go' (Text
l:[Text]
ls)
| Text -> Bool
T.null Text
l = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go' [Text]
ls
| Char -> Bool
isWhite (Text -> Char
T.head Text
l) = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go' [Text]
ls
| Bool
otherwise = Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ls
isWhite :: Char -> Bool
isWhite :: Char -> Bool
isWhite Char
' ' = Bool
True
isWhite Char
'\t' = Bool
True
isWhite Char
_ = Bool
False