    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards   #-}
    {-# LANGUAGE Safe              #-}

    -- |
    -- Copyright: © Herbert Valerio Riedel 2015-2018
    -- SPDX-License-Identifier: GPL-2.0-or-later
    --
    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

    -- internal
    type EvList = [Either String Event]
    type Node2EvList = [Node ()] -> EvList

    -- | Dump YAML Nodes as a lazy 'UTF8' encoded 'BS.L.ByteString'
    --
    -- Each YAML 'Node' is emitted as a individual YAML Document where each Document is terminated by a 'DocumentEnd' indicator.
    --
    -- This is a convenience wrapper over `encodeNode'`
    --
    -- @since 0.2.0
    encodeNode :: [Doc (Node ())] -> BS.L.ByteString
    encodeNode :: [Doc (Node ())] -> ByteString
    encodeNode = SchemaEncoder -> Encoding -> [Doc (Node ())] -> ByteString
    encodeNode' SchemaEncoder
    coreSchemaEncoder Encoding
    UTF8

    -- | Customizable variant of 'encodeNode'
    --
    -- __NOTE__: A leading <https://en.wikipedia.org/wiki/Byte_order_mark BOM> will be emitted for all encodings /other than/ 'UTF8'.
    --
    -- @since 0.2.0
    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)
    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
    schemaEncoderSequence :: Tag -> Either [Char] Tag
    schemaEncoderMapping :: Tag -> Either [Char] Tag
    schemaEncoderMapping :: SchemaEncoder -> Tag -> Either [Char] Tag
    schemaEncoderSequence :: SchemaEncoder -> Tag -> Either [Char] Tag
    schemaEncoderScalar :: SchemaEncoder -> Scalar -> Either [Char] (Tag, ScalarStyle, Text)
    ..} Encoding
    encoding [Doc (Node ())]
    nodes = Encoding -> [Event] -> ByteString
    writeEvents Encoding
    encoding ([Event] -> ByteString) -> [Event] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Either [Char] Event -> Event) -> [Either [Char] Event] -> [Event]
    forall a b. (a -> b) -> [a] -> [b]
    map Either [Char] Event -> Event
    getEvent (Node2EvList
    dumpEvents ((Doc (Node ()) -> Node ()) -> [Doc (Node ())] -> [Node ()]
    forall a b. (a -> b) -> [a] -> [b]
    map Doc (Node ()) -> Node ()
    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 -> [Char] -> Event
    forall a. HasCallStack => [Char] -> a
    error [Char]
    str

        dumpEvents :: Node2EvList
        dumpEvents :: Node2EvList
    dumpEvents [Node ()]
    nodes' = Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    StreamStartEither [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Node2EvList
    go0 [Node ()]
    nodes'
          where
            go0 :: [Node ()] -> EvList
            go0 :: Node2EvList
    go0 [] = [Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    StreamEnd]
            go0 [Node ()]
    n  = Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right (Directives -> Event
    DocumentStart Directives
    NoDirEndMarker)Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    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
    _ = [[Char] -> Either [Char] Event
    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 Maybe Text
    forall a. Maybe a
    NothingEither [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd Int
    lvl [Node ()]
    rest Node2EvList
    cont
              Mapping   ()
    _ Tag
    tag Mapping ()
    m  -> Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right (Maybe Text -> Tag -> NodeStyle -> Event
    MappingStart Maybe Text
    forall a. Maybe a
    Nothing ((Tag -> Either [Char] Tag) -> Tag -> Tag
    getTag Tag -> Either [Char] Tag
    schemaEncoderMapping Tag
    tag) NodeStyle
    Block) Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int
    -> Mapping () -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    goMap (Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Mapping ()
    m [Node ()]
    rest Node2EvList
    cont
              Sequence  ()
    _ Tag
    tag [Node ()]
    s  -> Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right (Maybe Text -> Tag -> NodeStyle -> Event
    SequenceStart Maybe Text
    forall a. Maybe a
    Nothing ((Tag -> Either [Char] Tag) -> Tag -> Tag
    getTag Tag -> Either [Char] Tag
    schemaEncoderSequence Tag
    tag) NodeStyle
    Block) Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int
    -> [Node ()] -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    goSeq (Int
    lvl Int -> Int -> Int
    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) -> Event -> Either [Char] Event
    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             -> [Char] -> Either [Char] Event
    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 (Mapping () -> [Node ()]
    forall {a}. Map a a -> [a]
    mapToList Mapping ()
    m) of
              []   -> Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    MappingEnd Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd (Int
    lvl Int -> Int -> Int
    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 []    = Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    MappingEnd Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd (Int
    lvl Int -> Int -> Int
    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 = (a -> a -> [a] -> [a]) -> [a] -> Map a a -> [a]
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
    Map.foldrWithKey (\a
    k a
    v [a]
    a -> a
    k a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : a
    v a -> [a] -> [a]
    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 = Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    SequenceEnd Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd (Int
    lvl Int -> Int -> Int
    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 []    = Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right Event
    SequenceEnd Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd (Int
    lvl Int -> Int -> Int
    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)Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    isDocEnd Int
    lvl [Node ()]
    rest Node2EvList
    cont
              Mapping   ()
    _ Tag
    tag Mapping ()
    m  -> Event -> Either [Char] Event
    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) Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int
    -> Mapping () -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    goMap (Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Mapping ()
    m [Node ()]
    rest Node2EvList
    cont
              Sequence  ()
    _ Tag
    tag [Node ()]
    s  -> Event -> Either [Char] Event
    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) Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    forall a. a -> [a] -> [a]
    : Int
    -> [Node ()] -> [Node ()] -> Node2EvList -> [Either [Char] Event]
    goSeq (Int
    lvl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [Node ()]
    s [Node ()]
    rest Node2EvList
    cont
              Anchor    ()
    _ NodeId
    _ Node ()
    _    -> [Char] -> Either [Char] Event
    forall a b. a -> Either a b
    Left [Char]
    "Anchor has a anchor node" Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    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 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then Event -> Either [Char] Event
    forall a b. b -> Either a b
    Right (Bool -> Event
    DocumentEnd ([Node ()]
    rest [Node ()] -> [Node ()] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []))Either [Char] Event
    -> [Either [Char] Event] -> [Either [Char] Event]
    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 NodeId -> NodeId -> Bool
    forall a. Eq a => a -> a -> Bool
    == (NodeId
    0NodeId -> NodeId -> NodeId
    forall a. Num a => a -> a -> a
    -NodeId
    1) = Maybe Text
    forall a. Maybe a
    Nothing
              | Bool
    otherwise    = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $! [Char] -> Text
    T.pack ([Char]
    "a" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ NodeId -> [Char]
    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 -> [Char] -> Tag
    forall a. HasCallStack => [Char] -> a
    error [Char]
    err