{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
module Data.YAML.Dumper
( encodeNode
, encodeNode'
) where
import Data.YAML.Event.Internal as YE
import Data.YAML.Event.Writer (writeEvents)
import Data.YAML.Internal as YI
import Data.YAML.Schema.Internal as YS
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.Map as Map
import qualified Data.Text as T
type EvList = [Either String Event]
type Node2EvList = [Node ()] -> EvList
encodeNode :: [Doc (Node ())] -> BS.L.ByteString
encodeNode :: [Doc (Node ())] -> ByteString
encodeNode = SchemaEncoder -> Encoding -> [Doc (Node ())] -> ByteString
encodeNode' SchemaEncoder
coreSchemaEncoder Encoding
UTF8
encodeNode' :: SchemaEncoder -> Encoding -> [Doc (Node ())] -> BS.L.ByteString
encodeNode' :: SchemaEncoder -> Encoding -> [Doc (Node ())] -> ByteString
encodeNode' SchemaEncoder{Tag -> Either [Char] Tag
Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderMapping :: SchemaEncoder -> Tag -> Either [Char] Tag
schemaEncoderSequence :: SchemaEncoder -> Tag -> Either [Char] Tag
schemaEncoderScalar :: SchemaEncoder -> Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
..} Encoding
encoding [Doc (Node ())]
nodes = Encoding -> [Event] -> ByteString
writeEvents Encoding
encoding forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Either [Char] Event -> Event
getEvent (Node2EvList
dumpEvents (forall a b. (a -> b) -> [a] -> [b]
map forall n. Doc n -> n
docRoot [Doc (Node ())]
nodes))
where
getEvent :: Either String Event -> Event
getEvent :: Either [Char] Event -> Event
getEvent = \Either [Char] Event
x -> case Either [Char] Event
x of
Right Event
ev -> Event
ev
Left [Char]
str -> forall a. HasCallStack => [Char] -> a
error [Char]
str
dumpEvents :: Node2EvList
dumpEvents :: Node2EvList
dumpEvents [Node ()]
nodes' = forall a b. b -> Either a b
Right Event
StreamStartforall a. a -> [a] -> [a]
: Node2EvList
go0 [Node ()]
nodes'
where
go0 :: [Node ()] -> EvList
go0 :: Node2EvList
go0 [] = [forall a b. b -> Either a b
Right Event
StreamEnd]
go0 [Node ()]
n = forall a b. b -> Either a b
Right (Directives -> Event
DocumentStart Directives
NoDirEndMarker)forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode (Int
0 :: Int) [Node ()]
n (\[Node ()]
ev -> Node2EvList
go0 [Node ()]
ev)
goNode :: Int -> [Node ()] -> Node2EvList -> EvList
goNode :: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode Int
_ [] Node2EvList
_ = [forall a b. a -> Either a b
Left [Char]
"Dumper: unexpected pattern in goNode"]
goNode Int
lvl (Node ()
node: [Node ()]
rest) Node2EvList
cont = case Node ()
node of
YI.Scalar ()
_ Scalar
scalar -> Scalar -> Maybe Text -> Either [Char] Event
goScalar Scalar
scalar forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd Int
lvl [Node ()]
rest Node2EvList
cont
Mapping ()
_ Tag
tag Mapping ()
m -> forall a b. b -> Either a b
Right (Maybe Text -> Tag -> NodeStyle -> Event
MappingStart forall a. Maybe a
Nothing ((Tag -> Either [Char] Tag) -> Tag -> Tag
getTag Tag -> Either [Char] Tag
schemaEncoderMapping Tag
tag) NodeStyle
Block) forall a. a -> [a] -> [a]
: Int
-> Mapping () -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goMap (Int
lvl forall a. Num a => a -> a -> a
+ Int
1) Mapping ()
m [Node ()]
rest Node2EvList
cont
Sequence ()
_ Tag
tag [Node ()]
s -> forall a b. b -> Either a b
Right (Maybe Text -> Tag -> NodeStyle -> Event
SequenceStart forall a. Maybe a
Nothing ((Tag -> Either [Char] Tag) -> Tag -> Tag
getTag Tag -> Either [Char] Tag
schemaEncoderSequence Tag
tag) NodeStyle
Block) forall a. a -> [a] -> [a]
: Int
-> [Node ()] -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goSeq (Int
lvl forall a. Num a => a -> a -> a
+ Int
1) [Node ()]
s [Node ()]
rest Node2EvList
cont
Anchor ()
_ NodeId
nid Node ()
n -> Int
-> NodeId
-> Node ()
-> [Node ()]
-> Node2EvList
-> [Either [Char] Event]
goAnchor Int
lvl NodeId
nid Node ()
n [Node ()]
rest Node2EvList
cont
goScalar :: YS.Scalar -> Maybe Anchor -> Either String Event
goScalar :: Scalar -> Maybe Text -> Either [Char] Event
goScalar Scalar
s Maybe Text
anc = case Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s of
Right (Tag
t, ScalarStyle
sty, Text
text) -> forall a b. b -> Either a b
Right (Maybe Text -> Tag -> ScalarStyle -> Text -> Event
YE.Scalar Maybe Text
anc Tag
t ScalarStyle
sty Text
text)
Left [Char]
err -> forall a b. a -> Either a b
Left [Char]
err
goMap :: Int -> Mapping () -> [Node ()] -> Node2EvList -> EvList
goMap :: Int
-> Mapping () -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goMap Int
lvl Mapping ()
m [Node ()]
rest Node2EvList
cont = case (forall {a}. Map a a -> [a]
mapToList Mapping ()
m) of
[] -> forall a b. b -> Either a b
Right Event
MappingEnd forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd (Int
lvl forall a. Num a => a -> a -> a
- Int
1) [Node ()]
rest Node2EvList
cont
[Node ()]
list -> Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode Int
lvl [Node ()]
list Node2EvList
g
where
g :: Node2EvList
g [] = forall a b. b -> Either a b
Right Event
MappingEnd forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd (Int
lvl forall a. Num a => a -> a -> a
- Int
1) [Node ()]
rest Node2EvList
cont
g [Node ()]
rest' = Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode Int
lvl [Node ()]
rest' Node2EvList
g
mapToList :: Map a a -> [a]
mapToList = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\a
k a
v [a]
a -> a
k forall a. a -> [a] -> [a]
: a
v forall a. a -> [a] -> [a]
: [a]
a) []
goSeq :: Int -> [Node ()] -> [Node ()] -> Node2EvList -> EvList
goSeq :: Int
-> [Node ()] -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goSeq Int
lvl [] [Node ()]
rest Node2EvList
cont = forall a b. b -> Either a b
Right Event
SequenceEnd forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd (Int
lvl forall a. Num a => a -> a -> a
- Int
1) [Node ()]
rest Node2EvList
cont
goSeq Int
lvl [Node ()]
nod [Node ()]
rest Node2EvList
cont = Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode Int
lvl [Node ()]
nod Node2EvList
g
where
g :: Node2EvList
g [] = forall a b. b -> Either a b
Right Event
SequenceEnd forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd (Int
lvl forall a. Num a => a -> a -> a
- Int
1) [Node ()]
rest Node2EvList
cont
g [Node ()]
rest' = Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goNode Int
lvl [Node ()]
rest' Node2EvList
g
goAnchor :: Int -> NodeId -> Node () -> [Node ()] -> Node2EvList -> EvList
goAnchor :: Int
-> NodeId
-> Node ()
-> [Node ()]
-> Node2EvList
-> [Either [Char] Event]
goAnchor Int
lvl NodeId
nid Node ()
nod [Node ()]
rest Node2EvList
cont = case Node ()
nod of
YI.Scalar ()
_ Scalar
scalar -> Scalar -> Maybe Text -> Either [Char] Event
goScalar Scalar
scalar (NodeId -> Maybe Text
ancName NodeId
nid)forall a. a -> [a] -> [a]
: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd Int
lvl [Node ()]
rest Node2EvList
cont
Mapping ()
_ Tag
tag Mapping ()
m -> forall a b. b -> Either a b
Right (Maybe Text -> Tag -> NodeStyle -> Event
MappingStart (NodeId -> Maybe Text
ancName NodeId
nid) ((Tag -> Either [Char] Tag) -> Tag -> Tag
getTag Tag -> Either [Char] Tag
schemaEncoderMapping Tag
tag) NodeStyle
Block) forall a. a -> [a] -> [a]
: Int
-> Mapping () -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goMap (Int
lvl forall a. Num a => a -> a -> a
+ Int
1) Mapping ()
m [Node ()]
rest Node2EvList
cont
Sequence ()
_ Tag
tag [Node ()]
s -> forall a b. b -> Either a b
Right (Maybe Text -> Tag -> NodeStyle -> Event
SequenceStart (NodeId -> Maybe Text
ancName NodeId
nid) ((Tag -> Either [Char] Tag) -> Tag -> Tag
getTag Tag -> Either [Char] Tag
schemaEncoderSequence Tag
tag) NodeStyle
Block) forall a. a -> [a] -> [a]
: Int
-> [Node ()] -> [Node ()] -> Node2EvList -> [Either [Char] Event]
goSeq (Int
lvl forall a. Num a => a -> a -> a
+ Int
1) [Node ()]
s [Node ()]
rest Node2EvList
cont
Anchor ()
_ NodeId
_ Node ()
_ -> forall a b. a -> Either a b
Left [Char]
"Anchor has a anchor node" forall a. a -> [a] -> [a]
: (Node2EvList
cont [Node ()]
rest)
isDocEnd :: Int -> [Node ()] -> Node2EvList -> EvList
isDocEnd :: Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
isDocEnd Int
lvl [Node ()]
rest Node2EvList
cont = if Int
lvl forall a. Eq a => a -> a -> Bool
== Int
0 then forall a b. b -> Either a b
Right (Bool -> Event
DocumentEnd ([Node ()]
rest forall a. Eq a => a -> a -> Bool
/= []))forall a. a -> [a] -> [a]
: (Node2EvList
cont [Node ()]
rest) else (Node2EvList
cont [Node ()]
rest)
ancName :: NodeId -> Maybe Anchor
ancName :: NodeId -> Maybe Text
ancName NodeId
nid
| NodeId
nid forall a. Eq a => a -> a -> Bool
== (NodeId
0forall a. Num a => a -> a -> a
-NodeId
1) = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! [Char] -> Text
T.pack ([Char]
"a" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show NodeId
nid)
getTag :: (Tag -> Either String Tag) -> Tag -> Tag
getTag :: (Tag -> Either [Char] Tag) -> Tag -> Tag
getTag Tag -> Either [Char] Tag
f Tag
tag = case Tag -> Either [Char] Tag
f Tag
tag of
Right Tag
t -> Tag
t
Left [Char]
err -> forall a. HasCallStack => [Char] -> a
error [Char]
err