{-# OPTIONS_HADDOCK not-home #-}

-- | Rendering of the syntax tree.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Yamlet.Internal.Render
  ( RenderOptions (..)
  , defaultRenderOptions
  , renderSyntax
  ) where

import Control.Applicative
import Data.Bifunctor
import Data.List qualified as L
import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.Builder.Linear qualified as B
import GHC.Generics

import Yamlet.Internal.Chars hiding (isAnchorChar)
import Yamlet.Internal.Emit
import Yamlet.Internal.Syntax hiding (document)
import Yamlet.Internal.Utils

-- A data type, so that a later release can add an option.
{- HLINT ignore RenderOptions "Use newtype instead of data" -}

-- | The options of 'renderSyntax'.
data RenderOptions = RenderOptions
  { RenderOptions -> Bool
forceBlock :: !Bool
  -- ^ Write every non-empty collection in the block style. A collection in a
  -- key then becomes an explicit key, e.g. @? - a@.
  }
  deriving stock (RenderOptions -> RenderOptions -> Bool
(RenderOptions -> RenderOptions -> Bool)
-> (RenderOptions -> RenderOptions -> Bool) -> Eq RenderOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderOptions -> RenderOptions -> Bool
== :: RenderOptions -> RenderOptions -> Bool
$c/= :: RenderOptions -> RenderOptions -> Bool
/= :: RenderOptions -> RenderOptions -> Bool
Eq, Int -> RenderOptions -> ShowS
[RenderOptions] -> ShowS
RenderOptions -> String
(Int -> RenderOptions -> ShowS)
-> (RenderOptions -> String)
-> ([RenderOptions] -> ShowS)
-> Show RenderOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderOptions -> ShowS
showsPrec :: Int -> RenderOptions -> ShowS
$cshow :: RenderOptions -> String
show :: RenderOptions -> String
$cshowList :: [RenderOptions] -> ShowS
showList :: [RenderOptions] -> ShowS
Show, (forall x. RenderOptions -> Rep RenderOptions x)
-> (forall x. Rep RenderOptions x -> RenderOptions)
-> Generic RenderOptions
forall x. Rep RenderOptions x -> RenderOptions
forall x. RenderOptions -> Rep RenderOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RenderOptions -> Rep RenderOptions x
from :: forall x. RenderOptions -> Rep RenderOptions x
$cto :: forall x. Rep RenderOptions x -> RenderOptions
to :: forall x. Rep RenderOptions x -> RenderOptions
Generic)

-- | Keep the collection styles of the tree.
defaultRenderOptions :: RenderOptions
defaultRenderOptions :: RenderOptions
defaultRenderOptions =
  RenderOptions
    { forceBlock :: Bool
forceBlock = Bool
False
    }

-- | Render documents with their comments and empty lines.
--
-- The output differs from the tree where YAML cannot hold it:
--
-- * A @---@ marker is on a line of its own, with at most a comment after
--   it.
--
-- * A scalar keeps its style if the style can hold its text, otherwise it
--   gets quotes. A block scalar that is a key or an entry of a flow
--   collection gets double quotes. A block scalar at the root gets quotes
--   in a few more cases, e.g. if its text starts with a space.
--
-- * The empty lines from the comments right after a block scalar with the
--   @+@ indicator go away, because they would become part of the scalar.
--
-- * A flow collection with comments inside becomes a block collection, so
--   that every comment has a line.
--
-- * A flow collection without comments is on one line, apart from the line
--   breaks of its multi-line scalars, so the empty lines between its entries
--   go away.
--
-- * A key of more than 1024 characters in a flow mapping becomes an explicit
--   key, e.g. @{? key : value}@, because YAML 1.1 parsers reject a longer
--   implicit key there too.
--
-- * A comment that has no place at its node moves to a place that has one,
--   e.g. the lines above the value of a key go above the key if the value
--   is on the line of the key.
--
-- * In the text of a comment, a character that YAML does not allow becomes
--   U+FFFD, and the white space at the end goes away. A line break starts a
--   new comment in a 'Yamlet.Syntax.CommentLine', and becomes a space in an
--   inline comment.
--
-- * An anchor name with a character that YAML does not allow in it, e.g. a
--   space, or that YAML 1.1 parsers read as the end of the name, e.g. @:@
--   or a line separator, becomes a new name in the anchor and in its
--   aliases. Names that only some parsers reject stay, e.g. @é@, which
--   libyaml rejects.
--
-- * A version that the parser does not support, e.g. 2.0, has no @%YAML@
--   directive.
--
-- With 'Yamlet.Syntax.forceBlock', the flow collections become block
-- collections:
--
-- >>> :{
-- case parseDocumentsText "a: [1, {b: 2}]\n" of
--   Left err -> putStrLn (prettyError "input.yaml" err)
--   Right docs ->
--     T.putStr (renderSyntax defaultRenderOptions {forceBlock = True} docs)
-- :}
-- a:
-- - 1
-- - b: 2
renderSyntax :: RenderOptions -> [Document] -> T.Text
renderSyntax :: RenderOptions -> [Document] -> Text
renderSyntax RenderOptions
opts = Text -> Text
emptyLines (Text -> Text) -> ([Document] -> Text) -> [Document] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder -> Text
B.runBuilder (Builder -> Text) -> ([Document] -> Builder) -> [Document] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Document] -> Builder
go Bool
True
  where
    -- The empty lines at the start or the end of the output go away, because
    -- the parser gives the lines there to no node. The empty lines in the
    -- content of a block scalar stay. Only the content of a block scalar
    -- with the keep indicator ends with an empty line, and the empty lines
    -- right after it go away, because they would become part of it.
    emptyLines :: T.Text -> T.Text
    emptyLines :: Text -> Text
emptyLines Text
t
      | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0') Text
t =
          [Text] -> Text
T.unlines
            ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
l -> if Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
emptyLine then Text
"" else Text
l)
            ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
dropEnd
            ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
emptyLine)
            ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
afterKeptLines
            ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t
      -- Every document ends with a line break, so the lines stay the same.
      | Bool
otherwise = Text
t

    afterKeptLines :: [T.Text] -> [T.Text]
    afterKeptLines :: [Text] -> [Text]
afterKeptLines = \case
      Text
a : [Text]
rest | Text -> Bool
T.null Text
a -> Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
afterKeptLines ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
emptyLine) [Text]
rest)
      Text
a : [Text]
rest -> Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
afterKeptLines [Text]
rest
      [] -> []

    dropEnd :: [T.Text] -> [T.Text]
    dropEnd :: [Text] -> [Text]
dropEnd = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
emptyLine) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse

    go :: Bool -> [Document] -> B.Builder
    go :: Bool -> [Document] -> Builder
go Bool
atStart = \case
      [] -> Builder
forall a. Monoid a => a
mempty
      Document
doc : [Document]
docs ->
        let nextLines :: Bool
nextLines = case [Document]
docs of
              Document
next : [Document]
_ -> Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Document
next.docComments.before)
              [] -> Bool
False
            prepared :: Document
prepared =
              Document -> Document
validAnchors Document
doc {root = topLevel nextLines (commentedBlocks doc.root)}
            -- Directives need an end marker above them. The document above
            -- writes it, so that its lines go where they read back from.
            ends :: Bool
ends =
              (Document -> Bool) -> [Document] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Document -> Bool
hasDirectives (Int -> [Document] -> [Document]
forall a. Int -> [a] -> [a]
take Int
1 [Document]
docs)
                Bool -> Bool -> Bool
|| RenderOptions -> Bool -> Bool -> Document -> Bool
writesEnd RenderOptions
opts (Bool -> Bool
not ([Document] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Document]
docs)) Bool
nextLines Document
prepared
        in Bool -> Bool -> Document -> Builder
document Bool
atStart Bool
ends Document
prepared Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> [Document] -> Builder
go Bool
False [Document]
docs

    -- A block scalar without content at the top level would take the lines
    -- below it in, also those of the next document if the flag tells that it
    -- has lines above its start marker. It gets quotes also when an end
    -- marker follows, which would end it, because the choice of the marker
    -- looks at the root with the quotes. Only the style changes.
    topLevel :: Bool -> Node -> Node
    topLevel :: Bool -> Node -> Node
topLevel Bool
nextLines Node
n = case Node
n.content of
      ScalarLinesContent ScalarStyle
style Text
t [Int]
starts
        | ScalarStyle -> Bool
isBlockScalar ScalarStyle
style
        , Text -> Bool
needsIndentIndicator Text
t
            Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t Bool -> Bool -> Bool
&& (Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Node
n.comments.after) Bool -> Bool -> Bool
|| Bool
nextLines) ->
            Node
n {content = ScalarLinesContent DoubleQuoted t starts}
      Content
_ -> Node
n

    -- A document. The flags tell if it starts the stream and if it ends with
    -- a document end marker.
    document :: Bool -> Bool -> Document -> B.Builder
    document :: Bool -> Bool -> Document -> Builder
document Bool
atStart Bool
ends Document
doc =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Builder
gap
        , Int -> [Line] -> Builder
lines_ Int
0 Document
doc.docComments.before
        , if Bool
directives
            then
              (YamlVersion -> Builder) -> Maybe YamlVersion -> Builder
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                ( \YamlVersion
v ->
                    Builder
"%YAML "
                      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
B.fromUnboundedDec YamlVersion
v.major
                      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."
                      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
B.fromUnboundedDec YamlVersion
v.minor
                      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
                )
                Maybe YamlVersion
version
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Char -> Builder) -> String -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Builder
tagDirective String
handles
            else Builder
forall a. Monoid a => a
mempty
        , Builder
body
        , if Bool
linesAboveEnd then Int -> [Line] -> Builder
lines_ Int
0 Document
doc.docComments.after else Builder
forall a. Monoid a => a
mempty
        , if Bool
ends then Builder
"...\n" else Builder
forall a. Monoid a => a
mempty
        , if Bool
linesAboveEnd then Builder
forall a. Monoid a => a
mempty else Int -> [Line] -> Builder
lines_ Int
0 Document
doc.docComments.after
        ]
      where
        r :: Node
        r :: Node
r = Document
doc.root

        -- The lines between a flow collection root and the end marker belong
        -- to the document, as do the lines below the marker. Below the
        -- marker, an empty line would end them.
        linesAboveEnd :: Bool
        linesAboveEnd :: Bool
linesAboveEnd = RenderOptions -> Node -> Bool
isFlowCollection RenderOptions
opts Node
r Bool -> Bool -> Bool
&& Line
EmptyLine Line -> [Line] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Document
doc.docComments.after

        -- The end of the document above takes the comments right below it.
        -- The lines above the first entry of a block root come first too.
        gap :: B.Builder
        gap :: Builder
gap = case if [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Document
doc.docComments.before Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
marker
          then RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
r
          else Document
doc.docComments.before of
          Comment Text
_ : [Line]
_ -> Int -> [Line] -> Builder
lines_ Int
0 [Line
EmptyLine]
          [Line]
_ -> Builder
forall a. Monoid a => a
mempty

        handles :: [Char]
        handles :: String
handles = Node -> String
tagHandles Node
r

        version :: Maybe YamlVersion
        version :: Maybe YamlVersion
version = Document -> Maybe YamlVersion
supportedVersion Document
doc

        directives :: Bool
        directives :: Bool
directives = Maybe YamlVersion -> Bool
forall a. Maybe a -> Bool
isJust Maybe YamlVersion
version Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
handles)

        -- A document needs a start marker after another document, after
        -- directives, for a comment on the marker line, and if it is empty. A
        -- block collection without properties has no line of its own for its
        -- comment. Without the marker, the lines above a document read back
        -- as the root's. YAML 1.2 needs no marker after an end marker, but
        -- YAML 1.1 parsers do.
        marker :: Bool
        marker :: Bool
marker =
          Document
doc.explicitStart
            Bool -> Bool -> Bool
|| Bool
directives
            Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
atStart
            Bool -> Bool -> Bool
|| Node -> Bool
isEmpty Node
r
            Bool -> Bool -> Bool
|| Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Document
doc.docComments.before)
            Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Document
doc.docComments.inline
            Bool -> Bool -> Bool
|| (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
r Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
r.comments.inline Bool -> Bool -> Bool
&& Maybe Builder -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Builder
propsLine)

        -- The properties of a block collection with its comment on their
        -- line, which keeps the lines above it from the first entry.
        propsLine :: Maybe B.Builder
        propsLine :: Maybe Builder
propsLine = case Node -> Maybe Builder
props Node
r of
          Just Builder
p
            | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
r, Just Text
c <- Node
r.comments.inline -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c))
          Maybe Builder
_ -> Maybe Builder
forall a. Maybe a
Nothing

        -- The marker line holds one comment. The comment of a block
        -- collection goes below it if the document has one too.
        (Maybe Text
markerComment, [Line]
rootLines) = case (Document
doc.docComments.inline, Node
r.comments.inline) of
          (Maybe Text
dc, Maybe Text
_) | Maybe Builder -> Bool
forall a. Maybe a -> Bool
isJust Maybe Builder
propsLine -> (Maybe Text
dc, Node
r.comments.before)
          (Just Text
dc, Just Text
rc)
            | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
r -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dc, Text -> Line
inlineLine Text
rc Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: Node
r.comments.before)
          (Maybe Text
dc, Maybe Text
rc) -> (Maybe Text
dc Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
r then Maybe Text
rc else Maybe Text
forall a. Maybe a
Nothing), Node
r.comments.before)

        startMarker :: B.Builder
        startMarker :: Builder
startMarker = if Bool
marker then Builder
"---" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
markerComment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" else Builder
forall a. Monoid a => a
mempty

        -- Below the line of the properties with a comment, the root takes the
        -- lines up to the last empty line, as below an indicator, so these
        -- lines of the first entry go above the properties. A first entry
        -- that starts below its indicator has its lines there.
        body :: B.Builder
        body :: Builder
body
          | Just Builder
p <- Maybe Builder
propsLine =
              let ([Line]
above, [Line]
below) = [Line] -> ([Line], [Line])
splitAtLastEmptyLine (RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
r)
              in Builder
startMarker
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
0 ([Line]
rootLines [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
above)
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
p
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
0 [Line]
below
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block RenderOptions
opts Int
0 Int
0 Bool
True (Bool -> Bool
not (RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
r)) Bool
False [] Node
r
          | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
r =
              Builder
startMarker
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_
                  Int
0
                  ( [Line] -> [Line]
separated [Line]
rootLines
                      [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ (if Maybe Builder -> Bool
forall a. Maybe a -> Bool
isJust (Node -> Maybe Builder
props Node
r) then RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
r else [])
                  )
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Node -> Maybe Builder
props Node
r)
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block
                  RenderOptions
opts
                  Int
0
                  Int
0
                  Bool
True
                  (Maybe Builder -> Bool
forall a. Maybe a -> Bool
isJust (Node -> Maybe Builder
props Node
r) Bool -> Bool -> Bool
&& Bool -> Bool
not (RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
r))
                  Bool
False
                  []
                  Node
r
          | Bool
otherwise = Builder
scalarBody Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Node -> Builder
linesBelow Int
0 Node
r

        scalarBody :: B.Builder
        scalarBody :: Builder
scalarBody
          | Node -> Bool
isEmpty Node
r =
              let (Maybe Text
c, [Line]
ls) = Document -> (Maybe Text, [Line])
emptyRootLines Document
doc
              in Builder
"---" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
0 [Line]
ls
          | Bool
marker =
              Builder
"---"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Document
doc.docComments.inline
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
0 Node
r.comments.before
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InValue Int
indentStep Node
r Node
r.comments.inline
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
          | Bool
otherwise =
              Int -> [Line] -> Builder
lines_ Int
0 Node
r.comments.before
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InValue Int
indentStep Node
r Node
r.comments.inline
                Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

-- | The node with every flow collection that has a comment inside
-- in the block style, so that every comment has a line. The comments of a
-- collection in its lines above and in its inline comment fit outside a flow
-- collection.
commentedBlocks :: Node -> Node
commentedBlocks :: Node -> Node
commentedBlocks = (Node, Bool) -> Node
forall a b. (a, b) -> a
fst ((Node, Bool) -> Node) -> (Node -> (Node, Bool)) -> Node -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> (Node, Bool)
go
  where
    -- The node, and whether it or a node inside it has a comment that does
    -- not fit outside a flow collection.
    go :: Node -> (Node, Bool)
    go :: Node -> (Node, Bool)
go Node
n = case Node
n.content of
      SequenceContent CollectionStyle
style [Node]
xs ->
        let ys :: [(Node, Bool)]
ys = (Node -> (Node, Bool)) -> [Node] -> [(Node, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Node -> (Node, Bool)
go [Node]
xs
            has :: Bool
has = Bool
linesAfter Bool -> Bool -> Bool
|| ((Node, Bool) -> Bool) -> [(Node, Bool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Node, Bool) -> Bool
inner [(Node, Bool)]
ys
        in (Node
n {content = SequenceContent (styleOf has style) (map fst ys)}, Bool
has)
      MappingContent CollectionStyle
style [(Node, Node)]
kvs ->
        let ys :: [((Node, Bool), (Node, Bool))]
ys = ((Node, Node) -> ((Node, Bool), (Node, Bool)))
-> [(Node, Node)] -> [((Node, Bool), (Node, Bool))]
forall a b. (a -> b) -> [a] -> [b]
map ((Node -> (Node, Bool))
-> (Node -> (Node, Bool))
-> (Node, Node)
-> ((Node, Bool), (Node, Bool))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Node -> (Node, Bool)
go Node -> (Node, Bool)
go) [(Node, Node)]
kvs
            has :: Bool
has = Bool
linesAfter Bool -> Bool -> Bool
|| (((Node, Bool), (Node, Bool)) -> Bool)
-> [((Node, Bool), (Node, Bool))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\((Node, Bool)
k, (Node, Bool)
v) -> (Node, Bool) -> Bool
inner (Node, Bool)
k Bool -> Bool -> Bool
|| (Node, Bool) -> Bool
inner (Node, Bool)
v) [((Node, Bool), (Node, Bool))]
ys
        in ( Node
n {content = MappingContent (styleOf has style) (map (bimap fst fst) ys)}
           , Bool
has
           )
      Content
_ -> (Node
n, Bool
linesAfter)
      where
        linesAfter :: Bool
        linesAfter :: Bool
linesAfter = [Line] -> Bool
hasCommentLine Node
n.comments.after

    inner :: (Node, Bool) -> Bool
    inner :: (Node, Bool) -> Bool
inner (Node
x, Bool
has) = [Line] -> Bool
hasCommentLine Node
x.comments.before Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline Bool -> Bool -> Bool
|| Bool
has

    styleOf :: Bool -> CollectionStyle -> CollectionStyle
    styleOf :: Bool -> CollectionStyle -> CollectionStyle
styleOf Bool
has CollectionStyle
style = if Bool
has then CollectionStyle
Block else CollectionStyle
style

-- | The document with anchor names that read back. A name that an anchor
-- cannot have becomes a name that no other anchor of the document has, in
-- its anchors and in its aliases.
validAnchors :: Document -> Document
validAnchors :: Document -> Document
validAnchors Document
doc
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
isAnchorName [Text]
names = Document
doc
  | Bool
otherwise = Document
doc {root = rename doc.root}
  where
    names :: [T.Text]
    names :: [Text]
names = Node -> [Text] -> [Text]
collect Document
doc.root []

    collect :: Node -> [T.Text] -> [T.Text]
    collect :: Node -> [Text] -> [Text]
collect Node
n [Text]
acc =
      ([Text] -> [Text])
-> (Text -> [Text] -> [Text]) -> Maybe Text -> [Text] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text] -> [Text]
forall a. a -> a
id (:) Node
n.props.anchor ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ case Node
n.content of
        AliasContent Text
a -> Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc
        SequenceContent CollectionStyle
_ [Node]
xs -> (Node -> [Text] -> [Text]) -> [Text] -> [Node] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Node -> [Text] -> [Text]
collect [Text]
acc [Node]
xs
        MappingContent CollectionStyle
_ [(Node, Node)]
kvs -> ((Node, Node) -> [Text] -> [Text])
-> [Text] -> [(Node, Node)] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Node
k, Node
v) -> Node -> [Text] -> [Text]
collect Node
k ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Text] -> [Text]
collect Node
v) [Text]
acc [(Node, Node)]
kvs
        ScalarContent ScalarStyle
_ Text
_ -> [Text]
acc

    newNames :: M.Map T.Text T.Text
    newNames :: Map Text Text
newNames =
      (\(Set Text
_, Map Text Int
_, Map Text Text
m) -> Map Text Text
m) ((Set Text, Map Text Int, Map Text Text) -> Map Text Text)
-> (Set Text, Map Text Int, Map Text Text) -> Map Text Text
forall a b. (a -> b) -> a -> b
$
        ((Set Text, Map Text Int, Map Text Text)
 -> Text -> (Set Text, Map Text Int, Map Text Text))
-> (Set Text, Map Text Int, Map Text Text)
-> [Text]
-> (Set Text, Map Text Int, Map Text Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (Set Text, Map Text Int, Map Text Text)
-> Text -> (Set Text, Map Text Int, Map Text Text)
add ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isAnchorName [Text]
names), Map Text Int
forall k a. Map k a
M.empty, Map Text Text
forall k a. Map k a
M.empty) [Text]
names

    -- The state has the used names, the next suffix to try for each base, and
    -- the new names. A suffix below the next one is used already, so the
    -- search does not try it again.
    add
      :: (S.Set T.Text, M.Map T.Text Int, M.Map T.Text T.Text)
      -> T.Text
      -> (S.Set T.Text, M.Map T.Text Int, M.Map T.Text T.Text)
    add :: (Set Text, Map Text Int, Map Text Text)
-> Text -> (Set Text, Map Text Int, Map Text Text)
add (Set Text
used, Map Text Int
next, Map Text Text
m) Text
a
      | Text -> Bool
isAnchorName Text
a Bool -> Bool -> Bool
|| Text -> Map Text Text -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Text
a Map Text Text
m = (Set Text
used, Map Text Int
next, Map Text Text
m)
      | Bool
otherwise =
          let base :: Text
base =
                if Text -> Bool
T.null Text
a
                  then Text
"anchor"
                  else (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char -> Bool
isAnchorChar Char
c then Char
c else Char
'_') Text
a
              (Text
new, Int
i) = Set Text -> Text -> Int -> (Text, Int)
fresh Set Text
used Text
base (Int -> Text -> Map Text Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
firstSuffix Text
base Map Text Int
next)
          in (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.insert Text
new Set Text
used, Text -> Int -> Map Text Int -> Map Text Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
base Int
i Map Text Int
next, Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
a Text
new Map Text Text
m)

    -- The name without a suffix is the first one, so the suffixes start at 2.
    firstSuffix :: Int
    firstSuffix :: Int
firstSuffix = Int
2

    -- The free name and the next suffix to try.
    fresh :: S.Set T.Text -> T.Text -> Int -> (T.Text, Int)
    fresh :: Set Text -> Text -> Int -> (Text, Int)
fresh Set Text
used Text
base Int
i
      | Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember Text
base Set Text
used = (Text
base, Int
i)
      | Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember Text
candidate Set Text
used = (Text
candidate, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise = Set Text -> Text -> Int -> (Text, Int)
fresh Set Text
used Text
base (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      where
        candidate :: T.Text
        candidate :: Text
candidate = Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)

    rename :: Node -> Node
    rename :: Node -> Node
rename Node
n =
      Node
n
        { props = n.props {anchor = newName <$> n.props.anchor}
        , content = case n.content of
            AliasContent Text
a -> Text -> Content
AliasContent (Text -> Text
newName Text
a)
            SequenceContent CollectionStyle
style [Node]
xs -> CollectionStyle -> [Node] -> Content
SequenceContent CollectionStyle
style ((Node -> Node) -> [Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Node
rename [Node]
xs)
            MappingContent CollectionStyle
style [(Node, Node)]
kvs ->
              CollectionStyle -> [(Node, Node)] -> Content
MappingContent CollectionStyle
style (((Node, Node) -> (Node, Node)) -> [(Node, Node)] -> [(Node, Node)]
forall a b. (a -> b) -> [a] -> [b]
map ((Node -> Node) -> (Node -> Node) -> (Node, Node) -> (Node, Node)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Node -> Node
rename Node -> Node
rename) [(Node, Node)]
kvs)
            Content
c -> Content
c
        }

    newName :: T.Text -> T.Text
    newName :: Text -> Text
newName Text
a = Text -> Text -> Map Text Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Text
a Text
a Map Text Text
newNames

    isAnchorName :: T.Text -> Bool
    isAnchorName :: Text -> Bool
isAnchorName Text
a = Bool -> Bool
not (Text -> Bool
T.null Text
a) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAnchorChar Text
a

    -- libyaml, PyYAML and go-yaml v2 end an anchor name at ':' and '?' and
    -- read the rest as content, without an error.
    isAnchorChar :: Char -> Bool
    isAnchorChar :: Char -> Bool
isAnchorChar Char
c =
      Char -> Bool
isScalarChar 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
':'
        Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?'
        Bool -> Bool -> Bool
&& Bool -> Bool
not ((Word8 -> Bool) -> Char -> Bool
asciiChar Word8 -> Bool
isFlowIndicator Char
c)

-- | The version of the document if the parser accepts it. The parser
-- rejects the other versions.
supportedVersion :: Document -> Maybe YamlVersion
supportedVersion :: Document -> Maybe YamlVersion
supportedVersion Document
doc = case Document
doc.version of
  Just YamlVersion
v | YamlVersion
v.major Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1, YamlVersion
v.minor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0, YamlVersion
v.minor Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxVersion -> YamlVersion -> Maybe YamlVersion
forall a. a -> Maybe a
Just YamlVersion
v
  Maybe YamlVersion
_ -> Maybe YamlVersion
forall a. Maybe a
Nothing

-- | The document starts with directives: a version or a tag handle.
hasDirectives :: Document -> Bool
hasDirectives :: Document -> Bool
hasDirectives Document
doc = Maybe YamlVersion -> Bool
forall a. Maybe a -> Bool
isJust (Document -> Maybe YamlVersion
supportedVersion Document
doc) Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Node -> String
tagHandles Document
doc.root))

-- | The document ends with a @...@ marker. The flags tell if another
-- document follows and if it has lines above its start marker.
--
-- Without the marker, the lines at the end of the document read back as the
-- root's, unless the root is a flow collection. Before the next document,
-- an empty line at the end of the root, or below a flow collection root,
-- would end the lines of the document, and a literal block scalar with the
-- keep indicator at the end would take the empty line above the lines of the
-- next document in.
writesEnd :: RenderOptions -> Bool -> Bool -> Document -> Bool
writesEnd :: RenderOptions -> Bool -> Bool -> Document -> Bool
writesEnd RenderOptions
opts Bool
next Bool
nextLines Document
doc =
  Document
doc.explicitEnd
    Bool -> Bool -> Bool
|| Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Document
doc.docComments.after) Bool -> Bool -> Bool
&& Bool -> Bool
not (RenderOptions -> Node -> Bool
isFlowCollection RenderOptions
opts Document
doc.root)
    Bool -> Bool -> Bool
|| Bool
next Bool -> Bool -> Bool
&& [Line] -> Bool
commentBelowEmptyLine [Line]
endLines
    Bool -> Bool -> Bool
|| Bool
nextLines Bool -> Bool -> Bool
&& Node -> Bool
endsWithKeep Document
doc.root
  where
    -- The lines at the end of the root, which read back as its last lines,
    -- or the lines of the document below a flow collection root. The lines
    -- of an empty root are all below its start marker.
    endLines :: [Line]
    endLines :: [Line]
endLines
      | Node -> Bool
isEmpty Document
doc.root = (Maybe Text, [Line]) -> [Line]
forall a b. (a, b) -> b
snd (Document -> (Maybe Text, [Line])
emptyRootLines Document
doc) [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Document
doc.root.comments.after
      | RenderOptions -> Node -> Bool
isFlowCollection RenderOptions
opts Document
doc.root = Document
doc.docComments.after
      | Bool
otherwise = Node -> [Line]
linesAtEnd Document
doc.root

    -- The lines at the end of the node and of the nodes that end it. The
    -- lines after the last key go below the entry if the value is not a block
    -- collection, as in 'entryComments'.
    linesAtEnd :: Node -> [Line]
    linesAtEnd :: Node -> [Line]
linesAtEnd Node
n = [Line]
inner [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
n.comments.after
      where
        inner :: [Line]
        inner :: [Line]
inner = case Node
n.content of
          SequenceContent CollectionStyle
_ [Node]
xs | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n, Node
x : [Node]
_ <- [Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
xs -> Node -> [Line]
linesAtEnd Node
x
          MappingContent CollectionStyle
_ [(Node, Node)]
kvs
            | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n
            , (Node
k, Node
v) : [(Node, Node)]
_ <- [(Node, Node)] -> [(Node, Node)]
forall a. [a] -> [a]
reverse [(Node, Node)]
kvs -> case RenderOptions -> Node -> Node -> ([Line], Maybe Text, [Line])
entryComments RenderOptions
opts Node
k Node
v of
                ([Line]
_, Maybe Text
_, [Line]
below) | Bool -> Bool
not (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
v) -> [Line]
below [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node -> [Line]
linesAtEnd Node
v
                ([Line], Maybe Text, [Line])
_ -> Node -> [Line]
linesAtEnd Node
v
          Content
_ -> []

    -- A comment line below the scalar ends its content.
    endsWithKeep :: Node -> Bool
    endsWithKeep :: Node -> Bool
endsWithKeep Node
n
      | [Line] -> Bool
hasCommentLine Node
n.comments.after = Bool
False
      | Bool
otherwise = case Node
n.content of
          ScalarContent ScalarStyle
Literal Text
t -> Maybe (Builder, Builder) -> Bool
forall a. Maybe a -> Bool
isJust (Int -> Text -> Maybe (Builder, Builder)
literalBlock Int
0 Text
t) Bool -> Bool -> Bool
&& Text -> Bool
hasKeepIndicator Text
t
          SequenceContent CollectionStyle
_ [Node]
xs | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n, Node
x : [Node]
_ <- [Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
xs -> Node -> Bool
endsWithKeep Node
x
          MappingContent CollectionStyle
_ [(Node, Node)]
kvs
            | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n, (Node
_, Node
v) : [(Node, Node)]
_ <- [(Node, Node)] -> [(Node, Node)]
forall a. [a] -> [a]
reverse [(Node, Node)]
kvs -> Node -> Bool
endsWithKeep Node
v
          Content
_ -> Bool
False

-- | The comment on the start marker line of a document with an empty root,
-- and the lines below the marker, without the lines at the end of the root.
-- The marker line holds one comment, so the comment of the root goes below
-- it if the document has one too.
emptyRootLines :: Document -> (Maybe T.Text, [Line])
emptyRootLines :: Document -> (Maybe Text, [Line])
emptyRootLines Document
doc = case (Document
doc.docComments.inline, Document
doc.root.comments.inline) of
  (Just Text
dc, Just Text
rc) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dc, Document
doc.root.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Text -> Line
inlineLine Text
rc])
  (Maybe Text
dc, Maybe Text
rc) -> (Maybe Text
dc Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
rc, Document
doc.root.comments.before)

-- | The lines have a comment below an empty line.
commentBelowEmptyLine :: [Line] -> Bool
commentBelowEmptyLine :: [Line] -> Bool
commentBelowEmptyLine [Line]
ls = case (Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
/= Line
EmptyLine) [Line]
ls of
  Line
_ : [Line]
rest -> [Line] -> Bool
hasCommentLine [Line]
rest
  [] -> Bool
False

-- | A collection that the renderer writes in the flow style.
isFlowCollection :: RenderOptions -> Node -> Bool
isFlowCollection :: RenderOptions -> Node -> Bool
isFlowCollection RenderOptions
opts Node
n = case Node
n.content of
  SequenceContent {} -> Bool -> Bool
not (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n)
  MappingContent {} -> Bool -> Bool
not (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n)
  Content
_ -> Bool
False

-- | The entries of a block collection at the given indentation, and the lines
-- after them at the given column. The first entry does not start with
-- indentation if the collection continues a line, and the lines above it are
-- not written if the caller wrote them already. The second flag tells if the
-- caller wrote the lines of the first entries of the chain that starts with
-- the first entry, as in @indicatorLines@. The given lines go to the first
-- entry if it starts below its indicator.
block
  :: RenderOptions -> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> B.Builder
block :: RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block RenderOptions
opts Int
indent Int
afterColumn Bool
atLineStart Bool
hoisted Bool
chainWritten [Line]
carried Node
n =
  case Node
n.content of
    SequenceContent CollectionStyle
_ [Node]
xs ->
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Int -> Node -> Builder) -> [Int] -> [Node] -> [Builder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Node -> Builder
item [Int
0 :: Int ..] [Node]
xs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
afterColumn Node
n.comments.after
    MappingContent CollectionStyle
_ [(Node, Node)]
kvs ->
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Int -> (Node, Node) -> Builder)
-> [Int] -> [(Node, Node)] -> [Builder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Node, Node) -> Builder
entry [Int
0 :: Int ..] [(Node, Node)]
kvs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
afterColumn Node
n.comments.after
    Content
_ -> Builder
forall a. Monoid a => a
mempty
  where
    start :: Int -> [Line] -> B.Builder
    start :: Int -> [Line] -> Builder
start Int
i [Line]
ls
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
atLineStart = Builder
forall a. Monoid a => a
mempty
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool
hoisted = Int -> Builder
spaces Int
indent
      | Bool
otherwise = Int -> [Line] -> Builder
lines_ Int
indent [Line]
ls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
spaces Int
indent

    -- Without the second case, the tuple of 'indicatorLines' makes the render
    -- benchmark of the config input allocate more.
    item :: Int -> Node -> B.Builder
    item :: Int -> Node -> Builder
item Int
i Node
x
      | RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
x =
          let ([Line]
above, [Line]
below, [Line]
rest, Bool
written) =
                Bool -> [Line] -> Node -> ([Line], [Line], [Line], Bool)
indicatorLines (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Line]
carried else []) Node
x
          in Int -> [Line] -> Builder
start Int
i [Line]
above
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-"
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> Builder
after RenderOptions
opts Int
indent (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) Bool
written [Line]
below [Line]
rest Node
x
      | Bool
otherwise =
          Int -> [Line] -> Builder
start Int
i (RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
x)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> Builder
after RenderOptions
opts Int
indent (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) Bool
False [] [] Node
x

    entry :: Int -> (Node, Node) -> B.Builder
    entry :: Int -> (Node, Node) -> Builder
entry Int
i (Node
k, Node
v) = case RenderOptions -> Node -> Maybe Builder
implicitKey RenderOptions
opts Node
k of
      Just Builder
key ->
        let ([Line]
above, Maybe Text
lineComment, [Line]
below) = RenderOptions -> Node -> Node -> ([Line], Maybe Text, [Line])
entryComments RenderOptions
opts Node
k Node
v
        in Int -> [Line] -> Builder
start Int
i [Line]
above Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Node -> Maybe Text -> [Line] -> Builder
value Node
v Maybe Text
lineComment [Line]
below
      Maybe Builder
Nothing ->
        let ([Line]
keyAbove, [Line]
keyBelow, [Line]
keyRest, Bool
keyWritten) =
              Bool -> [Line] -> Node -> ([Line], [Line], [Line], Bool)
indicatorLines (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Line]
carried else []) Node
k
            ([Line]
valueAbove, [Line]
valueBelow, [Line]
valueRest, Bool
valueWritten) = Bool -> [Line] -> Node -> ([Line], [Line], [Line], Bool)
indicatorLines Bool
False [] Node
v
        in Int -> [Line] -> Builder
start Int
i [Line]
keyAbove
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"?"
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> Builder
after RenderOptions
opts Int
indent Int
indent Bool
keyWritten [Line]
keyBelow [Line]
keyRest Node
k
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
indent [Line]
valueAbove
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
spaces Int
indent
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> Builder
after
               RenderOptions
opts
               Int
indent
               (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep)
               Bool
valueWritten
               [Line]
valueBelow
               [Line]
valueRest
               Node
v

    -- The lines above the indicator of a sequence item or an explicit entry,
    -- the lines below it, and the lines for the first entry of a block
    -- collection that starts below its indicator. The flag is set for the
    -- first entry of a collection, and the given lines come first.
    --
    -- The parser gives the lines above and below the indicator of a block
    -- collection that starts below it to the collection up to the last empty
    -- line, and the rest to its first entry. A comment on the line of the
    -- indicator keeps the lines above it from the first entry. Above the
    -- indicator of a first entry, the collection around it takes the lines
    -- up to the last empty line. So the lines of the collection after the
    -- last empty line go above the indicator if it has a comment and nothing
    -- else takes them there. Otherwise an empty line after them keeps them
    -- from the first entry, above the indicator of a later entry and below
    -- the indicator of a first entry. Without lines of the collection, the
    -- given lines go to its first entry.
    --
    -- The lines of the first entry also read back the same above the
    -- indicator, if they have no empty line and no node between them and the
    -- indicator has lines of its own or a comment on the line of its
    -- indicator. Then they go there, at the start of a line, so that the
    -- lines above a list item with an anchor stay above it. Through a chain
    -- of first entries that start below their indicators they go above the
    -- first indicator, and the last flag of the result tells the chain that
    -- they are written.
    indicatorLines :: Bool -> [Line] -> Node -> ([Line], [Line], [Line], Bool)
    indicatorLines :: Bool -> [Line] -> Node -> ([Line], [Line], [Line], Bool)
indicatorLines Bool
isFirst [Line]
given Node
x
      | RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
x =
          let ls :: [Line]
ls = [Line]
given [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
x.comments.before
              lineStart :: Bool
lineStart = Bool
atLineStart Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hoisted Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
chainWritten
              aboveFirst :: Bool
aboveFirst = Bool
isFirst Bool -> Bool -> Bool
&& [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
ls Bool -> Bool -> Bool
&& Bool
lineStart
          in if
               | RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
x ->
                   let ([Line]
own, [Line]
rest) = [Line] -> ([Line], [Line])
splitAtLastEmptyLine [Line]
ls
                       lifted :: Maybe [Line]
lifted = Maybe [Line] -> Maybe [Line]
liftable (Node -> Maybe Node
firstEntryOf Node
x Maybe Node -> (Node -> Maybe [Line]) -> Maybe [Line]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RenderOptions -> Node -> Maybe [Line]
chainLines RenderOptions
opts)
                   in if
                        | Bool
isFirst Bool -> Bool -> Bool
&& Bool
chainWritten -> ([], [Line]
own, [Line]
rest, Bool
True)
                        | Bool
aboveFirst, Just [Line]
ls' <- Maybe [Line]
lifted -> ([Line]
ls', [], [], Bool
True)
                        | Bool -> Bool
not Bool
isFirst
                        , Just [Line]
ls' <- Maybe [Line]
lifted ->
                            ([Line] -> [Line]
separated [Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
ls', [], [], Bool
True)
                        | [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Node
x.comments.before -> ([], [Line]
own, [Line]
rest, Bool
False)
                        | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline
                        , Bool -> Bool
not Bool
isFirst Bool -> Bool -> Bool
|| [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
own Bool -> Bool -> Bool
&& Bool
lineStart ->
                            ([Line]
ls, [], [], Bool
False)
                        | Bool
isFirst -> ([], [Line] -> [Line]
separated [Line]
ls, [], Bool
False)
                        | Bool
otherwise -> ([Line] -> [Line]
separated [Line]
ls, [], [], Bool
False)
               | Bool
isFirst Bool -> Bool -> Bool
&& Bool
chainWritten -> ([], [Line] -> [Line]
separated [Line]
ls, [], Bool
False)
               | Bool
aboveFirst
               , Just [Line]
ls' <- Maybe [Line] -> Maybe [Line]
liftable ([Line] -> Maybe [Line]
forall a. a -> Maybe a
Just (RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x)) ->
                   ([Line]
ls', [], [], Bool
False)
               -- An empty line above the indicator would give the lines up to
               -- it to the collection around, and one below it would give them
               -- to this collection.
               | Bool
isFirst
               , Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline
               , Bool
lineStart
               , Line
EmptyLine Line -> [Line] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x ->
                   ([Line]
ls, RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x, [], Bool
False)
               | Bool
isFirst -> ([], [Line] -> [Line]
separated [Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x, [], Bool
False)
               | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline ->
                   let ([Line]
above, [Line]
below) = [Line] -> ([Line], [Line])
splitAtLastEmptyLine (RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x)
                   in ([Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
above, [Line]
below, [], Bool
False)
               | Bool
otherwise -> ([Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x, [], [], Bool
False)
      | Bool
otherwise = (RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
x, [], [], Bool
False)
      where
        liftable :: Maybe [Line] -> Maybe [Line]
        liftable :: Maybe [Line] -> Maybe [Line]
liftable = \case
          Just [Line]
ls'
            | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Node
x.comments.inline
            , Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
ls')
            , Line
EmptyLine Line -> [Line] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Line]
ls' ->
                [Line] -> Maybe [Line]
forall a. a -> Maybe a
Just [Line]
ls'
          Maybe [Line]
_ -> Maybe [Line]
forall a. Maybe a
Nothing

    -- The value of a mapping entry after the colon with the comment of the
    -- line, and the line break. The lines go between the key and a block
    -- collection, or below the entry, indented deeper than the key, where
    -- the lines after the value go too.
    value :: Node -> Maybe T.Text -> [Line] -> B.Builder
    value :: Node -> Maybe Text -> [Line] -> Builder
value Node
v Maybe Text
lineComment [Line]
extra
      | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
v =
          -- Without the bang, the render benchmark of the config input
          -- allocates more.
          let !column :: Int
column = case Node
v.content of
                -- A sequence without indentation has no column of its own for
                -- the lines after its last item: a block collection or a block
                -- scalar as the last item takes in every line that is deeper
                -- than the key.
                SequenceContent CollectionStyle
_ [Node]
xs
                  | Bool -> Bool
not ([Line] -> Bool
hasCommentLine Node
v.comments.after) Bool -> Bool -> Bool
|| Bool -> Bool
not ([Node] -> Bool
endsWithBlock [Node]
xs) ->
                      Int
indent
                Content
_ -> Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep
          in Builder
header
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
column [Line]
below
               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block RenderOptions
opts Int
column (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) Bool
True Bool
False Bool
False [Line]
rest Node
v
      | Node -> Bool
isEmpty Node
v = Maybe Text -> Builder
comment Maybe Text
lineComment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
entryBelow
      | Bool
otherwise =
          Builder
" "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InValue (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) Node
v Maybe Text
lineComment
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
entryBelow
      where
        -- The lines after a block scalar end it at the column of the key.
        -- Without the first case, the render benchmark of the config input
        -- allocates more.
        entryBelow :: B.Builder
        entryBelow :: Builder
entryBelow
          | [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
extra Bool -> Bool -> Bool
&& [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Node
v.comments.after = Builder
forall a. Monoid a => a
mempty
          | Bool
otherwise =
              let column :: Int
column = if Node -> Bool
isBlockScalarNode Node
v then Int
indent else Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep
              in Int -> [Line] -> Builder
lines_ Int
column [Line]
extra Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Node -> Builder
linesBelow Int
column Node
v

        header :: B.Builder
        header :: Builder
header = Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Node -> Maybe Builder
props Node
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

        -- The value takes the lines below the key as in 'indicatorLines'.
        below, rest :: [Line]
        ([Line]
below, [Line]
rest)
          | RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
v = [Line] -> ([Line], [Line])
splitAtLastEmptyLine ([Line]
extra [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before)
          | Bool
otherwise = ([Line] -> [Line]
separated ([Line]
extra [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before), [])

        endsWithBlock :: [Node] -> Bool
        endsWithBlock :: [Node] -> Bool
endsWithBlock [Node]
xs = case [Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
xs of
          Node
x : [Node]
_ -> Node -> Bool
isBlockScalarNode Node
x Bool -> Bool -> Bool
|| RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
x
          [] -> Bool
False

-- 'after' stays at top level, although 'block' is its only caller. In the
-- where clause of 'block', it made the render benchmark of the config input
-- allocate more.

-- | A node after the indicator of a sequence item or an explicit entry, with
-- the line break, and the lines below the indicator and the lines for the
-- first entry from @indicatorLines@, with its flag for the lines of the
-- chain. A block collection starts on the same line if it can. The lines
-- after a scalar go at the given column.
after :: RenderOptions -> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> B.Builder
after :: RenderOptions
-> Int -> Int -> Bool -> [Line] -> [Line] -> Node -> Builder
after RenderOptions
opts Int
indent Int
column Bool
chainWritten [Line]
below [Line]
rest Node
n
  | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n =
      if RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
n
        then
          Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Node -> Maybe Builder
props Node
n)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Node
n.comments.inline
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) [Line]
below
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block
              RenderOptions
opts
              (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep)
              (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep)
              Bool
True
              (Bool -> Bool
not (RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
n))
              Bool
chainWritten
              [Line]
rest
              Node
n
        else
          Builder
" "
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions
-> Int -> Int -> Bool -> Bool -> Bool -> [Line] -> Node -> Builder
block
              RenderOptions
opts
              (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep)
              (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep)
              Bool
False
              Bool
True
              Bool
False
              []
              Node
n
  | Node -> Bool
isEmpty Node
n = Maybe Text -> Builder
comment Node
n.comments.inline Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Node -> Builder
linesBelow Int
column Node
n
  | Bool
otherwise =
      let column' :: Int
column' = if Node -> Bool
isBlockScalarNode Node
n then Int
indent else Int
column
      in Builder
" "
           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InValue (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentStep) Node
n Node
n.comments.inline
           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
           Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Node -> Builder
linesBelow Int
column' Node
n

-- | The lines of a block collection that go directly above its first entry.
-- The parser gives the lines there to the entry, so the lines of the
-- collection end with an empty line.
separated :: [Line] -> [Line]
separated :: [Line] -> [Line]
separated [Line]
ls = case [Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
ls of
  [] -> []
  Line
EmptyLine : [Line]
_ -> [Line]
ls
  [Line]
_ -> [Line]
ls [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line
EmptyLine]

-- | The lines above an indicator of a node that does not start below it. The
-- lines above the first entry of a block collection after the indicator go
-- there too.
aboveIndicator :: RenderOptions -> Node -> [Line]
aboveIndicator :: RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
x =
  Node
x.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ if RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
x then RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x else []

-- | The lines above the first entry of a collection, unless the entry starts
-- below its indicator and has the lines there.
firstLines :: RenderOptions -> Node -> [Line]
firstLines :: RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x
  | RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
x = []
  | Bool
otherwise = case Node
x.content of
      SequenceContent CollectionStyle
_ (Node
y : [Node]
_) -> RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
y
      MappingContent CollectionStyle
_ ((Node
k, Node
v) : [(Node, Node)]
_) -> case RenderOptions -> Node -> Maybe Builder
implicitKey RenderOptions
opts Node
k of
        Just Builder
_ -> let ([Line]
above, Maybe Text
_, [Line]
_) = RenderOptions -> Node -> Node -> ([Line], Maybe Text, [Line])
entryComments RenderOptions
opts Node
k Node
v in [Line]
above
        Maybe Builder
Nothing -> RenderOptions -> Node -> [Line]
aboveIndicator RenderOptions
opts Node
k
      Content
_ -> []

-- | The lines above the first entry at the end of a chain of first entries
-- that start below their indicators, from the node at its start, or 'Nothing'
-- if a node of the chain has lines of its own or a comment on the line of
-- its indicator.
chainLines :: RenderOptions -> Node -> Maybe [Line]
chainLines :: RenderOptions -> Node -> Maybe [Line]
chainLines RenderOptions
opts Node
x
  | Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Node
x.comments.before) Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline = Maybe [Line]
forall a. Maybe a
Nothing
  | RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
x = Node -> Maybe Node
firstEntryOf Node
x Maybe Node -> (Node -> Maybe [Line]) -> Maybe [Line]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RenderOptions -> Node -> Maybe [Line]
chainLines RenderOptions
opts
  | Bool
otherwise = [Line] -> Maybe [Line]
forall a. a -> Maybe a
Just (RenderOptions -> Node -> [Line]
firstLines RenderOptions
opts Node
x)

-- | The first item of a sequence, or the first key of a mapping.
firstEntryOf :: Node -> Maybe Node
firstEntryOf :: Node -> Maybe Node
firstEntryOf Node
x = case Node
x.content of
  SequenceContent CollectionStyle
_ (Node
y : [Node]
_) -> Node -> Maybe Node
forall a. a -> Maybe a
Just Node
y
  MappingContent CollectionStyle
_ ((Node
k, Node
_) : [(Node, Node)]
_) -> Node -> Maybe Node
forall a. a -> Maybe a
Just Node
k
  Content
_ -> Maybe Node
forall a. Maybe a
Nothing

-- | A block collection starts on the line after its indicator if it has
-- properties or a comment on the line of the indicator, or if the lines of
-- its first entry from 'firstLines' do not end with an empty line. A
-- collection on the line of its indicator takes every line above the
-- indicator, so these lines would read back as its own, or as those of a
-- collection around it. Below the indicator, the lines after the last empty
-- line go to the first entry.
--
-- The check looks at the lines of the first entry before it asks whether the
-- entry starts below its indicator. Most entries have no lines, so the check
-- does not follow a long chain of first entries from each of them, which
-- would make the time quadratic in the length of the chain. It follows the
-- chain only through entries with lines, and the output has these lines at
-- the indentation of their depth, so it is quadratic in that length too.
startsBelow :: RenderOptions -> Node -> Bool
startsBelow :: RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
x
  | Bool -> Bool
not (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
x) = Bool
False
  | Maybe Builder -> Bool
forall a. Maybe a -> Bool
isJust (Node -> Maybe Builder
props Node
x) Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline = Bool
True
  | Bool
otherwise = case Node
x.content of
      -- A first key without comments has no lines above it. Without the
      -- case, the check for an implicit key in 'belowIndicator' makes the
      -- render benchmark of the config input allocate more.
      MappingContent CollectionStyle
_ ((Node
k, Node
v) : [(Node, Node)]
_)
        | Node
k.comments Comments -> Comments -> Bool
forall a. Eq a => a -> a -> Bool
== Comments
noComments
        , Node
v.comments Comments -> Comments -> Bool
forall a. Eq a => a -> a -> Bool
== Comments
noComments
        , Bool -> Bool
not (RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
k) ->
            Bool
False
      Content
_ -> (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst (RenderOptions -> Node -> (Bool, Bool)
belowIndicator RenderOptions
opts Node
x)

-- | 'startsBelow' and whether 'firstLines' is empty. Both depend on the same
-- facts about the first entry, and with a separate check for each, the time
-- would be exponential in the length of a chain of first entries.
belowIndicator :: RenderOptions -> Node -> (Bool, Bool)
belowIndicator :: RenderOptions -> Node -> (Bool, Bool)
belowIndicator RenderOptions
opts Node
x =
  ( RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
x Bool -> Bool -> Bool
&& (Maybe Builder -> Bool
forall a. Maybe a -> Bool
isJust (Node -> Maybe Builder
props Node
x) Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
x.comments.inline Bool -> Bool -> Bool
|| Bool
firstHasLines)
  , Bool
noFirstLines
  )
  where
    firstHasLines, noFirstLines :: Bool
    (Bool
firstHasLines, Bool
noFirstLines) = case Node
x.content of
      SequenceContent CollectionStyle
_ (Node
y : [Node]
_) -> Node -> [Line] -> (Bool, Bool)
entry Node
y Node
y.comments.before
      MappingContent CollectionStyle
_ ((Node
k, Node
v) : [(Node, Node)]
_) -> case RenderOptions -> Node -> Maybe Builder
implicitKey RenderOptions
opts Node
k of
        Just Builder
_ ->
          let ([Line]
above, Maybe Text
_, [Line]
_) = RenderOptions -> Node -> Node -> ([Line], Maybe Text, [Line])
entryComments RenderOptions
opts Node
k Node
v in ([Line] -> Bool
endsWithLine [Line]
above, [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
above)
        Maybe Builder
Nothing -> Node -> [Line] -> (Bool, Bool)
entry Node
k Node
k.comments.before
      Content
_ -> (Bool
False, Bool
True)

    -- Whether the lines of the entry and those of its first entry, as in
    -- 'aboveIndicator', end with a line other than an empty line, and whether
    -- there are none. The lines of an entry that starts below its indicator
    -- stay there. The lines of its first entry end with an empty line if it
    -- has any, because otherwise the entry would start below its indicator.
    entry :: Node -> [Line] -> (Bool, Bool)
    entry :: Node -> [Line] -> (Bool, Bool)
entry Node
y [Line]
ls =
      let (Bool
below, Bool
none) = if RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
y then RenderOptions -> Node -> (Bool, Bool)
belowIndicator RenderOptions
opts Node
y else (Bool
False, Bool
True)
      in ([Line] -> Bool
endsWithLine [Line]
ls Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
below Bool -> Bool -> Bool
&& Bool
none, Bool
below Bool -> Bool -> Bool
|| [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
ls Bool -> Bool -> Bool
&& Bool
none)

    endsWithLine :: [Line] -> Bool
    endsWithLine :: [Line] -> Bool
endsWithLine [Line]
ls = case [Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
ls of
      Line
l : [Line]
_ -> Line
l Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
/= Line
EmptyLine
      [] -> Bool
False

-- | The first entry of a collection starts below its indicator.
firstStartsBelow :: RenderOptions -> Node -> Bool
firstStartsBelow :: RenderOptions -> Node -> Bool
firstStartsBelow RenderOptions
opts Node
x = case Node
x.content of
  SequenceContent CollectionStyle
_ (Node
y : [Node]
_) -> RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
y
  MappingContent CollectionStyle
_ ((Node
k, Node
_) : [(Node, Node)]
_) -> RenderOptions -> Node -> Bool
startsBelow RenderOptions
opts Node
k
  Content
_ -> Bool
False

-- | The lines up to the last empty line, and the lines after it.
splitAtLastEmptyLine :: [Line] -> ([Line], [Line])
splitAtLastEmptyLine :: [Line] -> ([Line], [Line])
splitAtLastEmptyLine [Line]
ls =
  let ([Line]
rest, [Line]
own) = (Line -> Bool) -> [Line] -> ([Line], [Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
EmptyLine) ([Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
ls)
  in ([Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
own, [Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
rest)

-- | The lines above an entry with an implicit key, the comment on its line
-- and the lines below the key. A line holds one comment. If the value is on
-- the line of the key, the lines above the value and the comment of the key
-- go above the entry. Otherwise the comment of the value goes below the key.
--
-- A scalar key has no place for the lines after it, so they go below the
-- key: between the key and a block collection value, or below the entry, as
-- in @value@. They read back as the lines of the value. Below a block scalar
-- they would be part of the scalar, and below a flow collection they would
-- read back as the lines of the next entry, so they go above the entry.
entryComments :: RenderOptions -> Node -> Node -> ([Line], Maybe T.Text, [Line])
entryComments :: RenderOptions -> Node -> Node -> ([Line], Maybe Text, [Line])
entryComments RenderOptions
opts Node
k Node
v
  | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
v = case (Node
k.comments.inline, Node
v.comments.inline) of
      (Just Text
kc, Just Text
vc) -> (Node
k.comments.before, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
kc, [Line]
keyAfter [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Text -> Line
inlineLine Text
vc])
      (Maybe Text
kc, Maybe Text
vc) -> (Node
k.comments.before, Maybe Text
kc Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
vc, [Line]
keyAfter)
  -- For a scalar value, only the place of the lines after the key differs.
  | Bool -> Bool
not (Node -> Bool
isScalarLike Node
v) Bool -> Bool -> Bool
|| Bool -> Bool
not ([Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
keyAfter) Bool -> Bool -> Bool
&& Node -> Bool
isBlockScalarNode Node
v =
      case (Node
k.comments.inline, Node
v.comments.inline) of
        (Just Text
kc, Just Text
vc) ->
          ( Node
k.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
keyAfter [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Text -> Line
inlineLine Text
kc]
          , Text -> Maybe Text
forall a. a -> Maybe a
Just Text
vc
          , []
          )
        (Maybe Text
kc, Maybe Text
vc) -> (Node
k.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
keyAfter [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before, Maybe Text
vc Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
kc, [])
  | Bool
otherwise = case (Node
k.comments.inline, Node
v.comments.inline) of
      (Just Text
kc, Just Text
vc) ->
        (Node
k.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Text -> Line
inlineLine Text
kc], Text -> Maybe Text
forall a. a -> Maybe a
Just Text
vc, [Line]
keyAfter)
      (Maybe Text
kc, Maybe Text
vc) -> (Node
k.comments.before [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ Node
v.comments.before, Maybe Text
vc Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
kc, [Line]
keyAfter)
  where
    keyAfter :: [Line]
    keyAfter :: [Line]
keyAfter
      | Node -> Bool
isScalarLike Node
k = Node
k.comments.after
      | Bool
otherwise = []

-- | A scalar that the renderer writes in the literal or the folded style. A
-- text that a block scalar cannot hold goes in double quotes.
isBlockScalarNode :: Node -> Bool
isBlockScalarNode :: Node -> Bool
isBlockScalarNode Node
n = case Node
n.content of
  ScalarContent ScalarStyle
Literal Text
t -> Maybe (Builder, Builder) -> Bool
forall a. Maybe a -> Bool
isJust (Int -> Text -> Maybe (Builder, Builder)
literalBlock Int
0 Text
t)
  ScalarContent ScalarStyle
Folded Text
t -> Maybe (Builder, Builder) -> Bool
forall a. Maybe a -> Bool
isJust (Int -> [Int] -> Text -> Maybe (Builder, Builder)
foldedBlock Int
0 [] Text
t)
  Content
_ -> Bool
False

-- | A scalar or an alias.
isScalarLike :: Node -> Bool
isScalarLike :: Node -> Bool
isScalarLike Node
n = case Node
n.content of
  SequenceContent {} -> Bool
False
  MappingContent {} -> Bool
False
  Content
_ -> Bool
True

-- | Where an inline node is. A scalar in a key is on one line.
data Position = InValue | InKey | InFlow | InFlowKey
  deriving stock (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq)

-- | A node with the given comment at the end of its last line. The lines of
-- a scalar after the first one are at the given indentation.
inline :: RenderOptions -> Position -> Int -> Node -> Maybe T.Text -> B.Builder
inline :: RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
pos Int
indent Node
n Maybe Text
lineComment = case Node
n.content of
  AliasContent Text
name -> Builder
"*" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment
  ScalarLinesContent ScalarStyle
style Text
t [Int]
starts
    | ScalarStyle -> Bool
isBlockScalar ScalarStyle
style Bool -> Bool -> Bool
&& Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
InValue -> Builder -> Builder
withProps (ScalarStyle -> Text -> [Int] -> Builder
blockScalar ScalarStyle
style Text
t [Int]
starts)
  Content
_ -> Builder -> Builder
withProps Builder
content_ Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment
  where
    withProps :: B.Builder -> B.Builder
    withProps :: Builder -> Builder
withProps Builder
b = case Node -> Maybe Builder
props Node
n of
      Just Builder
p
        | Bool
isEmpty' -> Builder
p
        | Bool
otherwise -> Builder
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
      Maybe Builder
Nothing -> Builder
b

    isEmpty' :: Bool
    isEmpty' :: Bool
isEmpty' = case Node
n.content of
      ScalarContent ScalarStyle
Plain Text
t -> Text -> Bool
T.null Text
t
      Content
_ -> Bool
False

    -- The comment goes on the line of the header.
    blockScalar :: ScalarStyle -> T.Text -> [Int] -> B.Builder
    blockScalar :: ScalarStyle -> Text -> [Int] -> Builder
blockScalar ScalarStyle
style Text
t [Int]
starts = case ScalarStyle
style of
      ScalarStyle
Literal | Just (Builder
h, Builder
b) <- Int -> Text -> Maybe (Builder, Builder)
literalBlock Int
indent Text
t -> Builder
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
      ScalarStyle
Folded | Just (Builder
h, Builder
b) <- Int -> [Int] -> Text -> Maybe (Builder, Builder)
foldedBlock Int
indent [Int]
starts Text
t -> Builder
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
      ScalarStyle
_ -> Int -> [Int] -> Text -> Builder
doubleQuotedLines Int
indent [Int]
starts Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Builder
comment Maybe Text
lineComment

    content_ :: B.Builder
    content_ :: Builder
content_ = case Node
n.content of
      ScalarLinesContent ScalarStyle
style Text
t [Int]
starts -> [Int] -> ScalarStyle -> Text -> Builder
scalar (if Bool
inKey then [] else [Int]
starts) ScalarStyle
style Text
t
      SequenceContent CollectionStyle
_ []
        | Node -> Bool
hasEndLines Node
n ->
            Builder
"[\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
indent (([Line], [Line]) -> [Line]
forall a b. (a, b) -> a
fst (Node -> ([Line], [Line])
bracketLines Node
n)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
spaces Int
indent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
      MappingContent CollectionStyle
_ []
        | Node -> Bool
hasEndLines Node
n ->
            Builder
"{\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> [Line] -> Builder
lines_ Int
indent (([Line], [Line]) -> [Line]
forall a b. (a, b) -> a
fst (Node -> ([Line], [Line])
bracketLines Node
n)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
spaces Int
indent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
      SequenceContent CollectionStyle
_ [Node]
xs -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
commas ((Node -> Builder) -> [Node] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Node -> Builder
flowValue (Node -> Builder) -> (Node -> Node) -> Node -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Node
flowItem) [Node]
xs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
      MappingContent CollectionStyle
_ [(Node, Node)]
kvs -> Builder
"{" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
commas (((Node, Node) -> Builder) -> [(Node, Node)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Node, Node) -> Builder
flowEntry [(Node, Node)]
kvs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
      AliasContent {} -> Builder
forall a. Monoid a => a
mempty

    inKey :: Bool
    inKey :: Bool
inKey = Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
InKey Bool -> Bool -> Bool
|| Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
InFlowKey

    -- The items of a flow collection in a key are in the key too.
    itemPos :: Position
    itemPos :: Position
itemPos = if Bool
inKey then Position
InFlowKey else Position
InFlow

    -- An empty scalar cannot be an item of a flow sequence.
    flowItem :: Node -> Node
    flowItem :: Node -> Node
flowItem Node
x = case Node
x.content of
      ScalarContent ScalarStyle
Plain Text
""
        | Props Maybe Text
Nothing Tag
NoTag <- Node
x.props ->
            Node
x {props = Props Nothing (Tag (coreTagPrefix <> "null"))}
      Content
_ -> Node
x

    -- YAML 1.2 allows an implicit key of any length in a flow mapping, but
    -- libyaml and PyYAML reject one as long as in a block mapping. YAML 1.1
    -- parsers also reject an empty implicit key, and a colon right before
    -- the end of the entry.
    flowEntry :: (Node, Node) -> B.Builder
    flowEntry :: (Node, Node) -> Builder
flowEntry (Node
k, Node
v)
      | Bool
fits Bool -> Bool -> Bool
&& Bool -> Bool
not (Node -> Bool
isEmpty Node
k) =
          [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
            [ Builder
key
            , if Node -> Bool
endsWithName Node
k then Builder
" : " else Builder
": "
            , Node -> Builder
flowValue Node
v
            ]
      -- libyaml rejects an explicit key with a colon but no value.
      | Bool
otherwise =
          [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
            [ Builder
"? "
            , Builder
key
            , if
                | Node -> Bool
isEmpty Node
v -> Node -> Builder
afterTag Node
k
                | Node -> Bool
isEmpty Node
k -> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Node -> Builder
flowValue Node
v
                | Bool
otherwise -> Builder
" : " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Node -> Builder
flowValue Node
v
            ]
      where
        -- The key is rendered at most once, so that a key inside a key does
        -- not double the time with each level.
        fits :: Bool
        key :: B.Builder
        (Bool
fits, Builder
key) = case (Node
k.props, Node
k.content) of
          -- A short scalar without properties fits even in two quotes with
          -- each character as the longest escape, \U and its digits.
          (Props Maybe Text
Nothing Tag
NoTag, ScalarContent ScalarStyle
_ Text
t)
            | Text -> Int -> Ordering
T.compareLength Text
t ((Int
maxImplicitKeyLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bigUEscapeDigits)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT ->
                (Bool
True, Builder
rendered)
          (Props, Content)
_
            | Int -> Node -> Bool
longerThan Int
maxImplicitKeyLength Node
k -> (Bool
False, Builder
rendered)
            | Bool
otherwise ->
                let t :: Text
t = Builder -> Text
Builder -> Text
B.runBuilder Builder
rendered
                    -- The space before the colon after a name is part of
                    -- the key for the limit.
                    limit :: Int
limit = Int
maxImplicitKeyLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- (if Node -> Bool
endsWithName Node
k then Int
1 else Int
0)
                in (Text -> Int -> Ordering
T.compareLength Text
t Int
limit Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT, Text -> Builder
B.fromText Text
t)

        rendered :: B.Builder
        rendered :: Builder
rendered = RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InFlowKey Int
indent Node
k Maybe Text
forall a. Maybe a
Nothing

    flowValue :: Node -> B.Builder
    flowValue :: Node -> Builder
flowValue Node
x = RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
itemPos Int
indent Node
x Maybe Text
forall a. Maybe a
Nothing Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Node -> Builder
afterTag Node
x

    -- YAML 1.1 parsers read a comma or a bracket right after a tag as part
    -- of the tag.
    afterTag :: Node -> B.Builder
    afterTag :: Node -> Builder
afterTag Node
x = case Node
x.content of
      ScalarContent ScalarStyle
Plain Text
t | Text -> Bool
T.null Text
t, Node
x.props.tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
NoTag -> Builder
" "
      Content
_ -> Builder
forall a. Monoid a => a
mempty

    commas :: [B.Builder] -> B.Builder
    commas :: [Builder] -> Builder
commas = \case
      [] -> Builder
forall a. Monoid a => a
mempty
      Builder
b : [Builder]
bs -> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) [Builder]
bs)

    -- A scalar in its style, or in a style that can hold its text, on the
    -- lines that start at the positions. The lines after the first one are at
    -- the indentation.
    scalar :: [Int] -> ScalarStyle -> T.Text -> B.Builder
    scalar :: [Int] -> ScalarStyle -> Text -> Builder
scalar [Int]
starts ScalarStyle
style Text
t = case ScalarStyle
style of
      ScalarStyle
Plain
        | Text -> Bool
T.null Text
t -> Builder
forall a. Monoid a => a
mempty
        | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
starts -> if Bool -> Text -> Bool
plainSyntax Bool
inFlow Text
t then Text -> Builder
B.fromText Text
t else Text -> Builder
quotedPlain Text
t
        | Just Builder
b <- Bool -> Int -> [Int] -> Text -> Maybe Builder
plainLines Bool
inFlow Int
indent [Int]
starts Text
t -> Builder
b
        | Bool
otherwise -> Int -> [Int] -> Text -> Builder
quotedPlainLines Int
indent [Int]
starts Text
t
      ScalarStyle
SingleQuoted ->
        Builder -> Maybe Builder -> Builder
forall a. a -> Maybe a -> a
fromMaybe (Int -> [Int] -> Text -> Builder
doubleQuotedLines Int
indent [Int]
starts Text
t) (Int -> [Int] -> Text -> Maybe Builder
singleQuotedLines Int
indent [Int]
starts Text
t)
      ScalarStyle
_ -> Int -> [Int] -> Text -> Builder
doubleQuotedLines Int
indent [Int]
starts Text
t
      where
        inFlow :: Bool
        inFlow :: Bool
inFlow = Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
InFlow Bool -> Bool -> Bool
|| Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
InFlowKey

-- | The node in a flow key has more characters than the limit. The count is
-- a lower bound, so that it needs no rendering: a character for each node
-- inside, at least that of a bracket, a comma or a colon, and the characters
-- of the scalars, the anchors, the aliases and the tags, each tag as if it
-- were a core tag written with !!. The count stops at the limit, so a node
-- inside many keys does not add time to each of them.
longerThan :: Int -> Node -> Bool
longerThan :: Int -> Node -> Bool
longerThan Int
limit Node
n0 = Int -> [Node] -> Int
go (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Node
n0] Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
  where
    -- The characters left before the limit, after the nodes.
    go :: Int -> [Node] -> Int
    go :: Int -> [Node] -> Int
go Int
left = \case
      [Node]
_ | Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Int
left
      [] -> Int
left
      Node
n : [Node]
rest -> case Node
n.content of
        ScalarContent ScalarStyle
_ Text
t -> Int -> [Node] -> Int
go (Node -> Int
own Node
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Text -> Int
upTo Int
left Text
t) [Node]
rest
        AliasContent Text
name -> Int -> [Node] -> Int
go (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Text -> Int
upTo Int
left Text
name) [Node]
rest
        SequenceContent CollectionStyle
_ [Node]
xs -> Int -> [Node] -> Int
go (Node -> Int
own Node
n) ([Node]
xs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
rest)
        MappingContent CollectionStyle
_ [(Node, Node)]
kvs -> Int -> [Node] -> Int
go (Node -> Int
own Node
n) (((Node, Node) -> [Node]) -> [(Node, Node)] -> [Node]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Node
k, Node
v) -> [Node
k, Node
v]) [(Node, Node)]
kvs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
rest)
        where
          own :: Node -> Int
          own :: Node -> Int
own Node
x = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Text -> Int
upTo Int
left) Node
x.props.anchor Int -> Int -> Int
forall a. Num a => a -> a -> a
- Tag -> Int
tagChars Node
x.props.tag

          tagChars :: Tag -> Int
          tagChars :: Tag -> Int
tagChars = \case
            Tag Text
t -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Text -> Int
upTo (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
coreShortening) Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
coreShortening)
            Tag
_ -> Int
0

    -- The length of the text, up to one past the count.
    upTo :: Int -> T.Text -> Int
    upTo :: Int -> Text -> Int
upTo Int
count Text
t = Text -> Int
T.length (Int -> Text -> Text
T.take (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t)

    -- A core tag loses its prefix and gains !!.
    coreShortening :: Int
    coreShortening :: Int
coreShortening = Text -> Int
T.length Text
coreTagPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

-- | A key on one line, or 'Nothing' if it needs an explicit entry.
implicitKey :: RenderOptions -> Node -> Maybe B.Builder
implicitKey :: RenderOptions -> Node -> Maybe Builder
implicitKey RenderOptions
opts Node
k
  | RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
k = Maybe Builder
forall a. Maybe a
Nothing
  | Node -> Bool
isEmpty Node
k = Maybe Builder
forall a. Maybe a
Nothing
  -- go-yaml v2 reads "[]: a" and "{}: a" without an error, but as an empty
  -- list or mapping, and drops the entries after them. An anchor or a tag
  -- avoids that.
  | Props Maybe Text
Nothing Tag
NoTag <- Node
k.props, Bool
isEmptyCollection = Maybe Builder
forall a. Maybe a
Nothing
  -- An empty collection with lines inside is on several lines.
  | Node -> Bool
hasEndLines Node
k, Bool -> Bool
not (Node -> Bool
isScalarLike Node
k) = Maybe Builder
forall a. Maybe a
Nothing
  | Text -> Int
T.length Text
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxImplicitKeyLength = Maybe Builder
forall a. Maybe a
Nothing
  | Bool
otherwise = Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Text -> Builder
B.fromText Text
key)
  where
    key :: T.Text
    key :: Text
key = case (Node
k.props, Node
k.content) of
      (Props Maybe Text
Nothing Tag
NoTag, ScalarContent ScalarStyle
Plain Text
t) | Bool -> Text -> Bool
plainSyntax Bool
False Text
t -> Text
t
      (Props, Content)
_ ->
        Builder -> Text
Builder -> Text
B.runBuilder (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
          RenderOptions -> Position -> Int -> Node -> Maybe Text -> Builder
inline RenderOptions
opts Position
InKey Int
0 Node
k Maybe Text
forall a. Maybe a
Nothing Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if Node -> Bool
endsWithName Node
k then Builder
" " else Builder
forall a. Monoid a => a
mempty

    isEmptyCollection :: Bool
    isEmptyCollection :: Bool
isEmptyCollection = case Node
k.content of
      SequenceContent CollectionStyle
_ [] -> Bool
True
      MappingContent CollectionStyle
_ [] -> Bool
True
      Content
_ -> Bool
False

-- | The node is a collection that the renderer writes in the block style.
isBlock :: RenderOptions -> Node -> Bool
isBlock :: RenderOptions -> Node -> Bool
isBlock RenderOptions
opts Node
n = case Node
n.content of
  SequenceContent CollectionStyle
style (Node
_ : [Node]
_) -> CollectionStyle
style CollectionStyle -> CollectionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CollectionStyle
Block Bool -> Bool -> Bool
|| RenderOptions
opts.forceBlock
  MappingContent CollectionStyle
style ((Node, Node)
_ : [(Node, Node)]
_) -> CollectionStyle
style CollectionStyle -> CollectionStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CollectionStyle
Block Bool -> Bool -> Bool
|| RenderOptions
opts.forceBlock
  Content
_ -> Bool
False

-- | The node has comments at its end, which go between the brackets of an
-- empty collection and below a scalar or an alias.
hasEndLines :: Node -> Bool
hasEndLines :: Node -> Bool
hasEndLines Node
n = case Node
n.content of
  SequenceContent CollectionStyle
_ (Node
_ : [Node]
_) -> Bool
False
  MappingContent CollectionStyle
_ ((Node, Node)
_ : [(Node, Node)]
_) -> Bool
False
  Content
_ -> [Line] -> Bool
hasCommentLine Node
n.comments.after

-- | The lines have a comment, not only empty lines.
hasCommentLine :: [Line] -> Bool
hasCommentLine :: [Line] -> Bool
hasCommentLine = (Line -> Bool) -> [Line] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
/= Line
EmptyLine)

-- | The lines at the end of a scalar or an alias at the given indentation.
-- They cannot be deeper, because a block scalar would take them in.
linesBelow :: Int -> Node -> B.Builder
linesBelow :: Int -> Node -> Builder
linesBelow Int
indent Node
n = case Node
n.content of
  ScalarContent {} -> Int -> [Line] -> Builder
lines_ Int
indent Node
n.comments.after
  AliasContent {} -> Int -> [Line] -> Builder
lines_ Int
indent Node
n.comments.after
  SequenceContent CollectionStyle
_ [] -> Int -> [Line] -> Builder
lines_ Int
indent (([Line], [Line]) -> [Line]
forall a b. (a, b) -> b
snd (Node -> ([Line], [Line])
bracketLines Node
n))
  MappingContent CollectionStyle
_ [] -> Int -> [Line] -> Builder
lines_ Int
indent (([Line], [Line]) -> [Line]
forall a b. (a, b) -> b
snd (Node -> ([Line], [Line])
bracketLines Node
n))
  Content
_ -> Builder
forall a. Monoid a => a
mempty

-- | The lines of an empty flow collection inside its brackets, and the
-- empty lines at their end, which go below the collection. The parser gives
-- the empty lines before a closing bracket to the node below.
bracketLines :: Node -> ([Line], [Line])
bracketLines :: Node -> ([Line], [Line])
bracketLines Node
n
  | Node -> Bool
hasEndLines Node
n =
      let ([Line]
empties, [Line]
rest) = (Line -> Bool) -> [Line] -> ([Line], [Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
EmptyLine) ([Line] -> [Line]
forall a. [a] -> [a]
reverse Node
n.comments.after)
      in ([Line] -> [Line]
forall a. [a] -> [a]
reverse [Line]
rest, [Line]
empties)
  | Bool
otherwise = ([], Node
n.comments.after)

-- | The node is an empty plain scalar without properties.
isEmpty :: Node -> Bool
isEmpty :: Node -> Bool
isEmpty Node
n = case (Node
n.props, Node
n.content) of
  (Props Maybe Text
Nothing Tag
NoTag, ScalarContent ScalarStyle
Plain Text
t) -> Text -> Bool
T.null Text
t
  (Props, Content)
_ -> Bool
False

-- | The node ends with an alias, an anchor or a tag. A colon right after it
-- would be part of the name.
endsWithName :: Node -> Bool
endsWithName :: Node -> Bool
endsWithName Node
n = case Node
n.content of
  AliasContent {} -> Bool
True
  ScalarContent ScalarStyle
Plain Text
t -> Text -> Bool
T.null Text
t Bool -> Bool -> Bool
&& (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Node
n.props.anchor Bool -> Bool -> Bool
|| Node
n.props.tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
NoTag)
  Content
_ -> Bool
False

-- | The anchor and the tag of a node.
props :: Node -> Maybe B.Builder
props :: Node -> Maybe Builder
props Node
n = case Node
n.content of
  AliasContent {} -> Maybe Builder
forall a. Maybe a
Nothing
  Content
_ -> case (Maybe Builder
anchor, Maybe Builder
tag) of
    (Maybe Builder
Nothing, Maybe Builder
Nothing) -> Maybe Builder
forall a. Maybe a
Nothing
    (Just Builder
a, Maybe Builder
Nothing) -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
a
    (Maybe Builder
Nothing, Just Builder
t) -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
t
    (Just Builder
a, Just Builder
t) -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
t)
  where
    anchor :: Maybe B.Builder
    anchor :: Maybe Builder
anchor = (Builder
"&" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
B.fromText (Text -> Builder) -> Maybe Text -> Maybe Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node
n.props.anchor

    tag :: Maybe B.Builder
    tag :: Maybe Builder
tag = case Node
n.props.tag of
      Tag
NoTag -> Maybe Builder
forall a. Maybe a
Nothing
      Tag
NonSpecificTag -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
"!"
      Tag Text
t -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Text -> Builder
tagText Text
t)

-- | A comment at the end of a line.
comment :: Maybe T.Text -> B.Builder
comment :: Maybe Text -> Builder
comment = \case
  Maybe Text
Nothing -> Builder
forall a. Monoid a => a
mempty
  Just Text
t -> Builder
" #" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text (Text -> Text
T.stripEnd (Text -> Text
printable (Text -> Text
breaksAsSpaces Text
t)))
  where
    text :: T.Text -> B.Builder
    text :: Text -> Builder
text Text
t = if Text -> Bool
T.null Text
t then Builder
forall a. Monoid a => a
mempty else Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
t

-- | An inline comment on a line of its own. It stays one comment, as at the
-- end of a line.
inlineLine :: T.Text -> Line
inlineLine :: Text -> Line
inlineLine = Text -> Line
Comment (Text -> Line) -> (Text -> Text) -> Text -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
breaksAsSpaces

breaksAsSpaces :: T.Text -> T.Text
breaksAsSpaces :: Text -> Text
breaksAsSpaces = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char -> Bool
isCommentBreak Char
c then Char
' ' else Char
c

-- | Lines of comments at the given indentation.
lines_ :: Int -> [Line] -> B.Builder
lines_ :: Int -> [Line] -> Builder
lines_ Int
indent = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Line] -> [Builder]) -> [Line] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Builder) -> [Line] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Builder
line
  where
    line :: Line -> B.Builder
    line :: Line -> Builder
line = \case
      Line
EmptyLine -> Text -> Builder
B.fromText Text
emptyLine Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
      CommentLine Int
n Text
t ->
        let hashes :: Builder
hashes = Text -> Builder
B.fromText (Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) Text
"#")
        in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Text] -> [Builder]) -> [Text] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Text -> Builder
commentLine Builder
hashes) ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$
             (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isCommentBreak (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\r\n" Text
"\n" (Text -> Text
printable Text
t))

    -- The parser drops the white space at the end of a comment.
    commentLine :: B.Builder -> T.Text -> B.Builder
    commentLine :: Builder -> Text -> Builder
commentLine Builder
hashes Text
l
      | Text -> Bool
T.null (Text -> Text
T.stripEnd Text
l) = Int -> Builder
spaces Int
indent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
hashes Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
      | Bool
otherwise = Int -> Builder
spaces Int
indent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
hashes Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText (Text -> Text
T.stripEnd Text
l) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

-- | The mark of an empty line from the comments. The output has no other NUL
-- character.
emptyLine :: T.Text
emptyLine :: Text
emptyLine = Text
"\0"

-- | The text of a comment with a replacement for the characters that YAML
-- does not allow.
printable :: T.Text -> T.Text
printable :: Text -> Text
printable = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c ->
  if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char -> Bool
isCommentBreak Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPrintable Char
c then Char
c else Char
'\xFFFD'

-- | A line break in the text of a comment. YAML 1.1 reads U+0085, U+2028 and
-- U+2029 as line breaks, so the rest of a comment after one of them would
-- read as data.
isCommentBreak :: Char -> Bool
isCommentBreak :: Char -> Bool
isCommentBreak Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x85' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2028' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2029'

-- $setup
-- >>> import Data.Text.IO qualified as T
-- >>> import Yamlet.Error
-- >>> import Yamlet.Syntax