{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HaskellCI.YamlSyntax (
    Yaml (..),
    reann,
    ToYaml (..),
    prettyYaml,
    -- * Helpers
    (~>),
    ykeyValuesFilt,
    ylistFilt,
    ) where

import HaskellCI.Prelude
import Prelude ()

import Data.Bits   (shiftR, (.&.))
import Data.Char   (isControl, isPrint, ord)
import Data.List   (dropWhileEnd)
import Data.Monoid (Endo (..))

import qualified Data.Aeson              as Aeson
import qualified Data.Aeson.Encoding     as AE
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key          as AK
import qualified Data.Aeson.KeyMap       as AKM
#else
import qualified Data.HashMap.Strict     as HM
#endif
import qualified Data.List.NonEmpty      as NE
import qualified Data.Map.Strict         as M
import qualified Data.Text               as T
import qualified Data.Text.Encoding      as TE
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.YAML               as YAML

import Numeric (showHex)

-- $setup
-- >>> :set -XOverloadedStrings

-------------------------------------------------------------------------------
-- Yaml syntx
-------------------------------------------------------------------------------

-- | This is not complete YAML document tree;
-- only as much as we need in @haskell-ci@.
data Yaml ann
    = YString ann String
    | YNumber ann Integer
    | YBool ann Bool
    | YList ann [Yaml ann]
    | YKeyValues ann [(ann, String, Yaml ann)]
    | YValue ann Aeson.Value  -- ^ inline JSON (for compactness)
  deriving (Yaml ann -> Yaml ann -> Bool
(Yaml ann -> Yaml ann -> Bool)
-> (Yaml ann -> Yaml ann -> Bool) -> Eq (Yaml ann)
forall ann. Eq ann => Yaml ann -> Yaml ann -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ann. Eq ann => Yaml ann -> Yaml ann -> Bool
== :: Yaml ann -> Yaml ann -> Bool
$c/= :: forall ann. Eq ann => Yaml ann -> Yaml ann -> Bool
/= :: Yaml ann -> Yaml ann -> Bool
Eq, Int -> Yaml ann -> ShowS
[Yaml ann] -> ShowS
Yaml ann -> String
(Int -> Yaml ann -> ShowS)
-> (Yaml ann -> String) -> ([Yaml ann] -> ShowS) -> Show (Yaml ann)
forall ann. Show ann => Int -> Yaml ann -> ShowS
forall ann. Show ann => [Yaml ann] -> ShowS
forall ann. Show ann => Yaml ann -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ann. Show ann => Int -> Yaml ann -> ShowS
showsPrec :: Int -> Yaml ann -> ShowS
$cshow :: forall ann. Show ann => Yaml ann -> String
show :: Yaml ann -> String
$cshowList :: forall ann. Show ann => [Yaml ann] -> ShowS
showList :: [Yaml ann] -> ShowS
Show, (forall a b. (a -> b) -> Yaml a -> Yaml b)
-> (forall a b. a -> Yaml b -> Yaml a) -> Functor Yaml
forall a b. a -> Yaml b -> Yaml a
forall a b. (a -> b) -> Yaml a -> Yaml b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Yaml a -> Yaml b
fmap :: forall a b. (a -> b) -> Yaml a -> Yaml b
$c<$ :: forall a b. a -> Yaml b -> Yaml a
<$ :: forall a b. a -> Yaml b -> Yaml a
Functor, (forall m. Monoid m => Yaml m -> m)
-> (forall m a. Monoid m => (a -> m) -> Yaml a -> m)
-> (forall m a. Monoid m => (a -> m) -> Yaml a -> m)
-> (forall a b. (a -> b -> b) -> b -> Yaml a -> b)
-> (forall a b. (a -> b -> b) -> b -> Yaml a -> b)
-> (forall b a. (b -> a -> b) -> b -> Yaml a -> b)
-> (forall b a. (b -> a -> b) -> b -> Yaml a -> b)
-> (forall a. (a -> a -> a) -> Yaml a -> a)
-> (forall a. (a -> a -> a) -> Yaml a -> a)
-> (forall a. Yaml a -> [a])
-> (forall a. Yaml a -> Bool)
-> (forall a. Yaml a -> Int)
-> (forall a. Eq a => a -> Yaml a -> Bool)
-> (forall a. Ord a => Yaml a -> a)
-> (forall a. Ord a => Yaml a -> a)
-> (forall a. Num a => Yaml a -> a)
-> (forall a. Num a => Yaml a -> a)
-> Foldable Yaml
forall a. Eq a => a -> Yaml a -> Bool
forall a. Num a => Yaml a -> a
forall a. Ord a => Yaml a -> a
forall m. Monoid m => Yaml m -> m
forall a. Yaml a -> Bool
forall a. Yaml a -> Int
forall a. Yaml a -> [a]
forall a. (a -> a -> a) -> Yaml a -> a
forall m a. Monoid m => (a -> m) -> Yaml a -> m
forall b a. (b -> a -> b) -> b -> Yaml a -> b
forall a b. (a -> b -> b) -> b -> Yaml a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Yaml m -> m
fold :: forall m. Monoid m => Yaml m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Yaml a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Yaml a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Yaml a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Yaml a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Yaml a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Yaml a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Yaml a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Yaml a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Yaml a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Yaml a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Yaml a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Yaml a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Yaml a -> a
foldr1 :: forall a. (a -> a -> a) -> Yaml a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Yaml a -> a
foldl1 :: forall a. (a -> a -> a) -> Yaml a -> a
$ctoList :: forall a. Yaml a -> [a]
toList :: forall a. Yaml a -> [a]
$cnull :: forall a. Yaml a -> Bool
null :: forall a. Yaml a -> Bool
$clength :: forall a. Yaml a -> Int
length :: forall a. Yaml a -> Int
$celem :: forall a. Eq a => a -> Yaml a -> Bool
elem :: forall a. Eq a => a -> Yaml a -> Bool
$cmaximum :: forall a. Ord a => Yaml a -> a
maximum :: forall a. Ord a => Yaml a -> a
$cminimum :: forall a. Ord a => Yaml a -> a
minimum :: forall a. Ord a => Yaml a -> a
$csum :: forall a. Num a => Yaml a -> a
sum :: forall a. Num a => Yaml a -> a
$cproduct :: forall a. Num a => Yaml a -> a
product :: forall a. Num a => Yaml a -> a
Foldable, Functor Yaml
Foldable Yaml
(Functor Yaml, Foldable Yaml) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Yaml a -> f (Yaml b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Yaml (f a) -> f (Yaml a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Yaml a -> m (Yaml b))
-> (forall (m :: * -> *) a. Monad m => Yaml (m a) -> m (Yaml a))
-> Traversable Yaml
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Yaml (m a) -> m (Yaml a)
forall (f :: * -> *) a. Applicative f => Yaml (f a) -> f (Yaml a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Yaml a -> m (Yaml b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Yaml a -> f (Yaml b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Yaml a -> f (Yaml b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Yaml a -> f (Yaml b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Yaml (f a) -> f (Yaml a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Yaml (f a) -> f (Yaml a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Yaml a -> m (Yaml b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Yaml a -> m (Yaml b)
$csequence :: forall (m :: * -> *) a. Monad m => Yaml (m a) -> m (Yaml a)
sequence :: forall (m :: * -> *) a. Monad m => Yaml (m a) -> m (Yaml a)
Traversable)

instance Monoid ann => IsString (Yaml ann) where
    fromString :: String -> Yaml ann
fromString = ann -> String -> Yaml ann
forall ann. ann -> String -> Yaml ann
YString ann
forall a. Monoid a => a
mempty

-- | Re-annotate top-level term
reann :: (ann -> ann) -> Yaml ann -> Yaml ann
reann :: forall ann. (ann -> ann) -> Yaml ann -> Yaml ann
reann ann -> ann
f (YString ann
ann String
s)     = ann -> String -> Yaml ann
forall ann. ann -> String -> Yaml ann
YString (ann -> ann
f ann
ann) String
s
reann ann -> ann
f (YNumber ann
ann Integer
i)     = ann -> Integer -> Yaml ann
forall ann. ann -> Integer -> Yaml ann
YNumber (ann -> ann
f ann
ann) Integer
i
reann ann -> ann
f (YBool ann
ann Bool
b)       = ann -> Bool -> Yaml ann
forall ann. ann -> Bool -> Yaml ann
YBool (ann -> ann
f ann
ann) Bool
b
reann ann -> ann
f (YList ann
ann [Yaml ann]
xs)      = ann -> [Yaml ann] -> Yaml ann
forall ann. ann -> [Yaml ann] -> Yaml ann
YList (ann -> ann
f ann
ann) [Yaml ann]
xs
reann ann -> ann
f (YKeyValues ann
ann [(ann, String, Yaml ann)]
xs) = ann -> [(ann, String, Yaml ann)] -> Yaml ann
forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
YKeyValues (ann -> ann
f ann
ann) [(ann, String, Yaml ann)]
xs
reann ann -> ann
f (YValue ann
ann Value
v)      = ann -> Value -> Yaml ann
forall ann. ann -> Value -> Yaml ann
YValue (ann -> ann
f ann
ann) Value
v

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------

class ToYaml a where
    toYaml :: a -> Yaml [String]

instance ann ~ [String] => ToYaml (Yaml ann) where
    toYaml :: Yaml ann -> Yaml [String]
toYaml = Yaml ann -> Yaml ann
Yaml ann -> Yaml [String]
forall a. a -> a
id

instance ToYaml Bool where
    toYaml :: Bool -> Yaml [String]
toYaml = [String] -> Bool -> Yaml [String]
forall ann. ann -> Bool -> Yaml ann
YBool []

instance ToYaml a => ToYaml [a] where
    toYaml :: [a] -> Yaml [String]
toYaml = [String] -> [Yaml [String]] -> Yaml [String]
forall ann. ann -> [Yaml ann] -> Yaml ann
YList [] ([Yaml [String]] -> Yaml [String])
-> ([a] -> [Yaml [String]]) -> [a] -> Yaml [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Yaml [String]) -> [a] -> [Yaml [String]]
forall a b. (a -> b) -> [a] -> [b]
map a -> Yaml [String]
forall a. ToYaml a => a -> Yaml [String]
toYaml

instance ToYaml Aeson.Value where
    toYaml :: Value -> Yaml [String]
toYaml = [String] -> Value -> Yaml [String]
forall ann. ann -> Value -> Yaml ann
YValue []

instance (k ~ String, ToYaml v) => ToYaml (M.Map k v) where
    toYaml :: Map k v -> Yaml [String]
toYaml Map k v
m = [String] -> [([String], String, Yaml [String])] -> Yaml [String]
forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt []
        [ k
String
k String -> Yaml [String] -> ([String], String, Yaml [String])
~> v -> Yaml [String]
forall a. ToYaml a => a -> Yaml [String]
toYaml v
v
        | (k
k, v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toList Map k v
m
        ]

-------------------------------------------------------------------------------
-- Converting to string
-------------------------------------------------------------------------------

-- | Convert 'Yaml' to 'String'. @ann@ can be converted to comments.
--
-- == Examples
--
-- >>> let demo = putStr . prettyYaml lines
--
-- >>> demo "foo"
-- foo
--
-- >>> demo "foo: bar"
-- "foo: bar"
--
-- >>> demo $ YString "a comment" "foo"
-- # a comment
-- foo
--
-- >>> demo $ YBool "a comment" True
-- # a comment
-- true
--
-- >>> demo $ YList "" []
-- []
--
-- >>> demo $ YList "" ["foo", "foo: bar"]
-- - foo
-- - "foo: bar"
--
-- >>> demo $ YList "comment1" [YString "comment2" "foo", YString "comment3" "foo: bar"]
-- # comment1
-- #
-- # comment2
-- - foo
-- # comment3
-- - "foo: bar"
--
-- >>> demo $ YKeyValues "" []
-- {}
--
-- >>> demo $ YKeyValues "" [("", "foo", "bar"), ("", "help", "welcome")]
-- foo: bar
-- help: welcome
--
-- >>> let nested = YKeyValues "comment1" [("comment2", "foo", YString "comment3" "bar"), ("comment4", "help", YString "comment5" "welcome")]
-- >>> demo nested
-- # comment1
-- #
-- # comment2
-- #
-- # comment3
-- foo: bar
-- # comment4
-- #
-- # comment5
-- help: welcome
--
-- >>> demo $ YKeyValues "top" [("", "nested", nested)]
-- # top
-- nested:
--   # comment1
--   #
--   # comment2
--   #
--   # comment3
--   foo: bar
--   # comment4
--   #
--   # comment5
--   help: welcome
--
-- >>> demo $ YValue "inline json" $ Aeson.toJSON [True, False, True]
-- # inline json
-- [true,false,true]
--
-- >>> demo $ YKeyValues "" [ ("", "addons", YValue "" $ Aeson.toJSON $ [Just "foo", Just "bar", Nothing]) ]
-- addons: ["foo","bar",null]
--
-- >>> demo $ YString "" $ unlines ["foo","bar","baz"]
-- "foo\nbar\nbaz\n"
--
-- >>> let multiline = YString "" $ unlines ["foo", "bar", "baz"]
-- >>> demo $ YList "" [multiline, multiline]
-- - |
--   foo
--   bar
--   baz
-- - |
--   foo
--   bar
--   baz
--
-- >>> demo $ YKeyValues "" [("", "keyA", multiline), ("", "keyB", multiline)]
-- keyA: |
--   foo
--   bar
--   baz
-- keyB: |
--   foo
--   bar
--   baz
--
prettyYaml :: forall ann. (ann -> [String]) -> Yaml ann -> String
prettyYaml :: forall ann. (ann -> [String]) -> Yaml ann -> String
prettyYaml ann -> [String]
comment' = NonEmpty (Int, Line) -> String
flatten (NonEmpty (Int, Line) -> String)
-> (Yaml ann -> NonEmpty (Int, Line)) -> Yaml ann -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Yaml ann -> NonEmpty (Int, Line)
go where
    comment :: ann -> [String]
    comment :: ann -> [String]
comment = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
lines' ([String] -> [String]) -> (ann -> [String]) -> ann -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ann -> [String]
comment' where
        lines' :: String -> [String]
lines' String
"" = [String
""]
        lines' String
s  = String -> [String]
lines String
s

    go :: Yaml ann -> NonEmpty (Int, Line)
    go :: Yaml ann -> NonEmpty (Int, Line)
go (YString ann
ann String
s) = case String -> Maybe ShowS
literal String
s of
        Just ShowS
ss -> (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) ShowS
ss)
        Maybe ShowS
Nothing -> (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
encodeYAMLString String
s)

    go (YNumber ann
ann Integer
i) =
        (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
i))

    go (YBool ann
ann Bool
b) =
        (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"true" else String
"false"))

    go (YValue ann
ann Value
v) =
        (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Value -> String
encodeValue Value
v))

    go (YList ann
ann [])     = (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (String -> ShowS
showString String
"[]"))
    go (YList ann
ann (Yaml ann
x:[Yaml ann]
xs)) = (Int, Line)
y (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:| ([(Int, Line)]
ys [(Int, Line)] -> [(Int, Line)] -> [(Int, Line)]
forall a. [a] -> [a] -> [a]
++ [(Int, Line)]
yss)
      where
        y :: (Int, Line)
        ys :: [(Int, Line)]
        ~((Int, Line)
y :| [(Int, Line)]
ys) = case Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line))
goSub Yaml ann
x of
            Right ((Int
_, Line [String]
cs ShowS
z) :| [(Int, Line)]
zs) ->
                (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann [String] -> [String] -> [String]
+++ [String]
cs) (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"- " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
z) (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:|
                ((Int, Line) -> (Int, Line)) -> [(Int, Line)] -> [(Int, Line)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int, Line) -> (Int, Line)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Int
forall a. Enum a => a -> a
succ) [(Int, Line)]
zs

            Left ([String]
cs, [String]
ls) ->
                (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann [String] -> [String] -> [String]
+++ [String]
cs) (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"- |") (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:|
                [ (Int
1, [String] -> ShowS -> Line
Line [] (String -> ShowS
showString String
l))
                | String
l <- [String]
ls
                ]

        yss :: [(Int, Line)]
        yss :: [(Int, Line)]
yss = do
            Either ([String], [String]) (NonEmpty (Int, Line))
e <- Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line))
goSub (Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line)))
-> [Yaml ann]
-> [Either ([String], [String]) (NonEmpty (Int, Line))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Yaml ann]
xs
            case Either ([String], [String]) (NonEmpty (Int, Line))
e of
                Right ((Int
_, Line [String]
cs ShowS
z) :| [(Int, Line)]
zs) ->
                    (Int
0, [String] -> ShowS -> Line
Line [String]
cs (String -> ShowS
showString String
"- " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
z)) (Int, Line) -> [(Int, Line)] -> [(Int, Line)]
forall a. a -> [a] -> [a]
:
                    ((Int, Line) -> (Int, Line)) -> [(Int, Line)] -> [(Int, Line)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int, Line) -> (Int, Line)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Int
forall a. Enum a => a -> a
succ) [(Int, Line)]
zs
                Left ([String]
cs, [String]
ls) ->
                    (Int
0, [String] -> ShowS -> Line
Line [String]
cs (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"- |") (Int, Line) -> [(Int, Line)] -> [(Int, Line)]
forall a. a -> [a] -> [a]
:
                    [ (Int
1, [String] -> ShowS -> Line
Line [] (String -> ShowS
showString String
l))
                    | String
l <- [String]
ls
                    ]

    go (YKeyValues ann
ann [])     = (Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (String -> ShowS
showString String
"{}"))
    go (YKeyValues ann
ann ((ann, String, Yaml ann)
x:[(ann, String, Yaml ann)]
xs)) = [String] -> (ann, String, Yaml ann) -> NonEmpty (Int, Line)
kv (ann -> [String]
comment ann
ann) (ann, String, Yaml ann)
x NonEmpty (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. NonEmpty a -> [a] -> NonEmpty a
<+> ([(ann, String, Yaml ann)]
xs [(ann, String, Yaml ann)]
-> ((ann, String, Yaml ann) -> [(Int, Line)]) -> [(Int, Line)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NonEmpty (Int, Line) -> [(Int, Line)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (Int, Line) -> [(Int, Line)])
-> ((ann, String, Yaml ann) -> NonEmpty (Int, Line))
-> (ann, String, Yaml ann)
-> [(Int, Line)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> (ann, String, Yaml ann) -> NonEmpty (Int, Line)
kv [])
      where
        kv :: [String] -> (ann, String, Yaml ann) -> NonEmpty (Int, Line)
        kv :: [String] -> (ann, String, Yaml ann) -> NonEmpty (Int, Line)
kv [String]
cs (ann
ann', String
k, Yaml ann
v) = case Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line))
goSub Yaml ann
v of
            -- single line
            Right ((Int
_, Line [String]
cs' ShowS
s) :| []) | Yaml ann -> Bool
forall a. Yaml a -> Bool
isScalar Yaml ann
v ->
                (Int
0, [String] -> ShowS -> Line
Line ([String]
cs [String] -> [String] -> [String]
+++ ann -> [String]
comment ann
ann' [String] -> [String] -> [String]
+++ [String]
cs') (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$
                    String -> ShowS
showString String
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:|
                    []
            -- multiline non escaped
            Left ([String]
cs', [String]
ls) ->
                (Int
0, [String] -> ShowS -> Line
Line ([String]
cs [String] -> [String] -> [String]
+++ ann -> [String]
comment ann
ann' [String] -> [String] -> [String]
+++ [String]
cs') (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$
                    String -> ShowS
showString String
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": |") (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:|
                    [ (Int
1, [String] -> ShowS -> Line
Line [] (String -> ShowS
showString String
l))
                    | String
l <- [String]
ls
                    ]
            -- multiline
            Right NonEmpty (Int, Line)
vs ->
                (Int
0, [String] -> ShowS -> Line
Line ([String]
cs [String] -> [String] -> [String]
+++ ann -> [String]
comment ann
ann') (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
':') (Int, Line) -> [(Int, Line)] -> NonEmpty (Int, Line)
forall a. a -> [a] -> NonEmpty a
:|
                NonEmpty (Int, Line) -> [(Int, Line)]
forall a. NonEmpty a -> [a]
NE.toList (((Int, Line) -> (Int, Line))
-> NonEmpty (Int, Line) -> NonEmpty (Int, Line)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int, Line) -> (Int, Line)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Int
forall a. Enum a => a -> a
succ) NonEmpty (Int, Line)
vs)

    -- which values can be on the same line with `:`
    isScalar :: Yaml ann -> Bool
isScalar YBool {}   = Bool
True
    isScalar YString {} = Bool
True
    isScalar YValue {}  = Bool
True
    isScalar Yaml ann
_          = Bool
False

    goSub :: Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line))
    goSub :: Yaml ann -> Either ([String], [String]) (NonEmpty (Int, Line))
goSub (YString ann
ann String
s) = case String -> Maybe ShowS
literal String
s of
        Just ShowS
ss -> NonEmpty (Int, Line)
-> Either ([String], [String]) (NonEmpty (Int, Line))
forall a b. b -> Either a b
Right ((Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) ShowS
ss))
        Maybe ShowS
Nothing -> case String -> Maybe [String]
multiline String
s of
            Just [String]
ll -> ([String], [String])
-> Either ([String], [String]) (NonEmpty (Int, Line))
forall a b. a -> Either a b
Left (ann -> [String]
comment ann
ann, [String]
ll)
            Maybe [String]
Nothing -> NonEmpty (Int, Line)
-> Either ([String], [String]) (NonEmpty (Int, Line))
forall a b. b -> Either a b
Right ((Int, Line) -> NonEmpty (Int, Line)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, [String] -> ShowS -> Line
Line (ann -> [String]
comment ann
ann) (ShowS -> Line) -> ShowS -> Line
forall a b. (a -> b) -> a -> b
$ String -> ShowS
encodeYAMLString String
s))
    goSub Yaml ann
y = NonEmpty (Int, Line)
-> Either ([String], [String]) (NonEmpty (Int, Line))
forall a b. b -> Either a b
Right (Yaml ann -> NonEmpty (Int, Line)
go Yaml ann
y)

    -- given "foo" can it be encode without quotes:
    --
    --    foo
    --
    literal :: String -> Maybe ShowS
    literal :: String -> Maybe ShowS
literal String
s = case ByteString -> Either (Pos, String) [Text]
forall v. FromYAML v => ByteString -> Either (Pos, String) [v]
YAML.decodeStrict ByteString
bs of
        Right [Text
t'] | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t' -> ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (String -> ShowS
showString String
s)
        Either (Pos, String) [Text]
_                    -> Maybe ShowS
forall a. Maybe a
Nothing
      where
        t :: Text
t  = String -> Text
T.pack String
s
        bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf8 Text
t

    -- when not top level, we can encode "foo\nbar\n" as
    --
    --     - |
    --       foo
    --       bar
    --
    -- Note: the input have to end with @\n@ for this to be triggered.
    --
    multiline :: String -> Maybe [String]
    multiline :: String -> Maybe [String]
multiline String
s
        | Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'\n' String
s = case ByteString -> Either (Pos, String) [[Text]]
forall v. FromYAML v => ByteString -> Either (Pos, String) [v]
YAML.decodeStrict ByteString
bs of
            Right [[Text
t']] | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t' -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
ls
            Either (Pos, String) [[Text]]
_                      -> Maybe [String]
forall a. Maybe a
Nothing
        | Bool
otherwise = Maybe [String]
forall a. Maybe a
Nothing
      where
        ls :: [String]
ls = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s
        t :: Text
t  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
ls

        ys :: String
ys = String
"- |\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
l -> String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") [String]
ls
        yt :: Text
yt  = String -> Text
T.pack String
ys
        bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf8 Text
yt

    -- when concatenating comment blocks, we add an empty line in between
    (+++) :: [String] -> [String] -> [String]
    [] +++ :: [String] -> [String] -> [String]
+++ [String]
xs = [String]
xs
    [String]
xs +++ [] = [String]
xs
    [String]
xs +++ [String]
ys = [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ys

    -- We can concatenate a list to a 'NonEmpty' list, the result is 'NonEmpty'.
    (<+>) :: NonEmpty a -> [a] -> NonEmpty a
    (a
x :| [a]
xs) <+> :: forall a. NonEmpty a -> [a] -> NonEmpty a
<+> [a]
ys = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys)

    flatten :: NonEmpty (Int, Line) -> String
    flatten :: NonEmpty (Int, Line) -> String
flatten NonEmpty (Int, Line)
xs = Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo (((Int, Line) -> Endo String) -> NonEmpty (Int, Line) -> Endo String
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Line) -> Endo String
f NonEmpty (Int, Line)
xs) String
"" where
        f :: (Int, Line) -> Endo String
f (Int
lvl, Line [String]
cs ShowS
s)
            | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ShowS
s String
"") = (String -> Endo String) -> [String] -> Endo String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Endo String
showComment [String]
cs Endo String -> Endo String -> Endo String
forall a. Semigroup a => a -> a -> a
<> ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
'\n')
            | Bool
otherwise   = (String -> Endo String) -> [String] -> Endo String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Endo String
showComment [String]
cs Endo String -> Endo String -> Endo String
forall a. Semigroup a => a -> a -> a
<> ShowS -> Endo String
g ShowS
s
          where
            showComment :: String -> Endo String
showComment String
"" = ShowS -> Endo String
g (String -> ShowS
showString String
"#")
            showComment String
c  = ShowS -> Endo String
g (String -> ShowS
showString String
"# " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
c)
            g :: ShowS -> Endo String
g ShowS
x = ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (String -> ShowS
showString String
lvl' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\n')
            lvl' :: String
lvl' = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '

encodeValue :: Aeson.Value -> String
encodeValue :: Value -> String
encodeValue = Text -> String
TL.unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
AE.encodingToLazyByteString (Encoding' Value -> ByteString)
-> (Value -> Encoding' Value) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding' Value
enc where
    enc :: Aeson.Value -> Aeson.Encoding
    enc :: Value -> Encoding' Value
enc Value
Aeson.Null       = Encoding' Value
AE.null_
    enc (Aeson.Bool Bool
b)   = Bool -> Encoding' Value
AE.bool Bool
b
    enc (Aeson.Number Scientific
n) = Scientific -> Encoding' Value
AE.scientific Scientific
n
    enc (Aeson.String Text
s) = Text -> Encoding' Value
forall a. Text -> Encoding' a
AE.text Text
s
    enc (Aeson.Array Array
v)  = (Value -> Encoding' Value) -> [Value] -> Encoding' Value
forall a. (a -> Encoding' Value) -> [a] -> Encoding' Value
AE.list Value -> Encoding' Value
enc (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
v)
    enc (Aeson.Object Object
m) = (Text -> Encoding' Key)
-> (Value -> Encoding' Value)
-> (forall a.
    (Text -> Value -> a -> a) -> a -> Map Text Value -> a)
-> Map Text Value
-> Encoding' Value
forall k v m.
(k -> Encoding' Key)
-> (v -> Encoding' Value)
-> (forall a. (k -> v -> a -> a) -> a -> m -> a)
-> m
-> Encoding' Value
AE.dict Text -> Encoding' Key
forall a. Text -> Encoding' a
AE.text Value -> Encoding' Value
enc (Text -> Value -> a -> a) -> a -> Map Text Value -> a
forall a. (Text -> Value -> a -> a) -> a -> Map Text Value -> a
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (Object -> Map Text Value
forall {a}. KeyMap a -> Map Text a
toMap Object
m)

#if MIN_VERSION_aeson(2,0,0)
    toMap :: KeyMap a -> Map Text a
toMap = [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, a)] -> Map Text a)
-> (KeyMap a -> [(Text, a)]) -> KeyMap a -> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, a) -> (Text, a)) -> [(Key, a)] -> [(Text, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Key
k, a
v) -> (Key -> Text
AK.toText Key
k, a
v)) ([(Key, a)] -> [(Text, a)])
-> (KeyMap a -> [(Key, a)]) -> KeyMap a -> [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap a -> [(Key, a)]
forall v. KeyMap v -> [(Key, v)]
AKM.toList
#else
    toMap = M.fromList . HM.toList
#endif

-- a 'Line' is comments before in and actual text after!
data Line = Line [String] ShowS

-- | Encode string to our best knowledge YAML string should be encoded.
-- Note: different than JSON
--
-- >>> putStrLn $ encodeYAMLString "\NULabcd\n" ""
-- "\x00abcd\n"
--
encodeYAMLString :: String -> ShowS
encodeYAMLString :: String -> ShowS
encodeYAMLString String
s
    = Char -> ShowS
showChar Char
'"'
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo ((Char -> Endo String) -> String -> Endo String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (ShowS -> Endo String) -> (Char -> ShowS) -> Char -> Endo String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
f) String
s)
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"'
  where
    f :: Char -> ShowS
    f :: Char -> ShowS
f Char
'\\' = String -> ShowS
showString String
"\\\\"
    f Char
'\n' = String -> ShowS
showString String
"\\n"
    f Char
'"'  = String -> ShowS
showString String
"\\\""
    f Char
c | Char -> Bool
isControl Char
c Bool -> Bool -> Bool
|| Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
128 Bool -> Bool -> Bool
|| Bool -> Bool
not (Char -> Bool
isPrint Char
c)
        = Char -> ShowS
hexChar Char
c
        | Bool
otherwise
        = Char -> ShowS
showChar Char
c

-- | Produce a hex encoding of a character.
-- Uses two hex chars if they are enough, otherwise four.
-- For out of BMP characters, do nothing.
--
-- >>> putStrLn $ hexChar ' ' ""
-- \x20
--
-- >>> putStrLn $ hexChar '\1234' ""
-- \x04d2
--
hexChar :: Char -> ShowS
hexChar :: Char -> ShowS
hexChar Char
c
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
65536 = Char -> ShowS
showChar Char
c
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256   = String -> ShowS
showString String
"\\x"
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n  Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n  Int
4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n  Int
0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
    | Bool
otherwise = String -> ShowS
showString String
"\\x"
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n  Int
4 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
showHexDigit (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
n  Int
0 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xf)
  where
    n :: Int
    n :: Int
n = Char -> Int
ord Char
c

    showHexDigit :: Int -> ShowS
    showHexDigit :: Int -> ShowS
showHexDigit = Int -> ShowS
forall a. Integral a => a -> ShowS
showHex

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

(~>) :: String -> Yaml [String] -> ([String], String, Yaml [String])
String
k ~> :: String -> Yaml [String] -> ([String], String, Yaml [String])
~> Yaml [String]
v = ([],String
k,Yaml [String]
v)

ykeyValuesFilt :: ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt :: forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
ykeyValuesFilt ann
ann [(ann, String, Yaml ann)]
xs = ann -> [(ann, String, Yaml ann)] -> Yaml ann
forall ann. ann -> [(ann, String, Yaml ann)] -> Yaml ann
YKeyValues ann
ann
    [ (ann, String, Yaml ann)
x
    | x :: (ann, String, Yaml ann)
x@(ann
_,String
_,Yaml ann
y)  <- [(ann, String, Yaml ann)]
xs
    , Bool -> Bool
not (Yaml ann -> Bool
forall a. Yaml a -> Bool
isEmpty Yaml ann
y)
    ]

ylistFilt :: ann -> [Yaml ann] -> Yaml ann
ylistFilt :: forall ann. ann -> [Yaml ann] -> Yaml ann
ylistFilt ann
ann [Yaml ann]
xs = ann -> [Yaml ann] -> Yaml ann
forall ann. ann -> [Yaml ann] -> Yaml ann
YList ann
ann
    [ Yaml ann
x
    | Yaml ann
x <- [Yaml ann]
xs
    , Bool -> Bool
not (Yaml ann -> Bool
forall a. Yaml a -> Bool
isEmpty Yaml ann
x)
    ]

isEmpty :: Yaml ann -> Bool
isEmpty :: forall a. Yaml a -> Bool
isEmpty (YList ann
_ [])      = Bool
True
isEmpty (YKeyValues ann
_ []) = Bool
True
isEmpty Yaml ann
_                 = Bool
False