{-# LANGUAGE TypeFamilies #-}
module Toml.Type.Printer
( PrintOptions(..)
, Lines(..)
, defaultOptions
, pretty
, prettyOptions
, prettyKey
) where
import GHC.Exts (sortWith)
import Data.Bifunctor (first)
import Data.Char (isAscii, ord)
import Data.Coerce (coerce)
import Data.Function (on)
import Data.HashMap.Strict (HashMap)
import Data.List (sortBy, foldl')
import Data.List.NonEmpty (NonEmpty)
import Data.Semigroup (stimes)
import Data.Text (Text)
import Data.Time (ZonedTime, defaultTimeLocale, formatTime)
import Text.Printf (printf)
import Toml.Type.AnyValue (AnyValue (..))
import Toml.Type.Key (Key (..), Piece (..))
import Toml.Type.PrefixTree (PrefixMap, PrefixTree (..))
import Toml.Type.TOML (TOML (..))
import Toml.Type.Value (Value (..))
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
data PrintOptions = PrintOptions
{
PrintOptions -> Maybe (Key -> Key -> Ordering)
printOptionsSorting :: !(Maybe (Key -> Key -> Ordering))
, PrintOptions -> Int
printOptionsIndent :: !Int
, PrintOptions -> Lines
printOptionsLines :: !Lines
}
defaultOptions :: PrintOptions
defaultOptions :: PrintOptions
defaultOptions = Maybe (Key -> Key -> Ordering) -> Int -> Lines -> PrintOptions
PrintOptions ((Key -> Key -> Ordering) -> Maybe (Key -> Key -> Ordering)
forall a. a -> Maybe a
Just Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) Int
2 Lines
OneLine
data Lines = OneLine | MultiLine
pretty :: TOML -> Text
pretty :: TOML -> Text
pretty = PrintOptions -> TOML -> Text
prettyOptions PrintOptions
defaultOptions
prettyOptions :: PrintOptions -> TOML -> Text
prettyOptions :: PrintOptions -> TOML -> Text
prettyOptions PrintOptions
options = [Text] -> Text
Text.unlines ([Text] -> Text) -> (TOML -> [Text]) -> TOML -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintOptions -> Int -> Text -> TOML -> [Text]
prettyTomlInd PrintOptions
options Int
0 Text
""
prettyTomlInd :: PrintOptions
-> Int
-> Text
-> TOML
-> [Text]
prettyTomlInd :: PrintOptions -> Int -> Text -> TOML -> [Text]
prettyTomlInd PrintOptions
options Int
i Text
prefix TOML{HashMap Key (NonEmpty TOML)
HashMap Key AnyValue
PrefixMap TOML
tomlPairs :: HashMap Key AnyValue
tomlTables :: PrefixMap TOML
tomlTableArrays :: HashMap Key (NonEmpty TOML)
tomlPairs :: TOML -> HashMap Key AnyValue
tomlTables :: TOML -> PrefixMap TOML
tomlTableArrays :: TOML -> HashMap Key (NonEmpty TOML)
..} = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ PrintOptions -> Int -> HashMap Key AnyValue -> [Text]
prettyKeyValue PrintOptions
options Int
i HashMap Key AnyValue
tomlPairs
, PrintOptions -> Int -> Text -> PrefixMap TOML -> [Text]
prettyTables PrintOptions
options Int
i Text
prefix PrefixMap TOML
tomlTables
, PrintOptions
-> Int -> Text -> HashMap Key (NonEmpty TOML) -> [Text]
prettyTableArrays PrintOptions
options Int
i Text
prefix HashMap Key (NonEmpty TOML)
tomlTableArrays
]
prettyKey :: Key -> Text
prettyKey :: Key -> Text
prettyKey = Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> (Key -> [Text]) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> [Text])
-> (Key -> NonEmpty Text) -> Key -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> NonEmpty Text
forall a b. Coercible a b => a -> b
coerce
{-# INLINE prettyKey #-}
prettyKeyValue :: PrintOptions -> Int -> HashMap Key AnyValue -> [Text]
prettyKeyValue :: PrintOptions -> Int -> HashMap Key AnyValue -> [Text]
prettyKeyValue PrintOptions
options Int
i = ((Key, AnyValue) -> [Text])
-> PrintOptions -> [(Key, AnyValue)] -> [Text]
forall v t. ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]
mapOrdered (\(Key, AnyValue)
kv -> [(Key, AnyValue) -> Text
kvText (Key, AnyValue)
kv]) PrintOptions
options ([(Key, AnyValue)] -> [Text])
-> (HashMap Key AnyValue -> [(Key, AnyValue)])
-> HashMap Key AnyValue
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Key AnyValue -> [(Key, AnyValue)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
where
kvText :: (Key, AnyValue) -> Text
kvText :: (Key, AnyValue) -> Text
kvText (Key
k, AnyValue Value t
v) =
PrintOptions -> Int -> Text
tabWith PrintOptions
options Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value t -> Text
forall (t :: TValue). Value t -> Text
valText Value t
v
valText :: Value t -> Text
valText :: forall (t :: TValue). Value t -> Text
valText (Bool Bool
b) = Text -> Text
Text.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text
forall a. Show a => a -> Text
showText Bool
b
valText (Integer Integer
n) = Integer -> Text
forall a. Show a => a -> Text
showText Integer
n
valText (Double Double
d) = Double -> Text
showDouble Double
d
valText (Text Text
s) = Text -> Text
showTextUnicode Text
s
valText (Zoned ZonedTime
z) = ZonedTime -> Text
showZonedTime ZonedTime
z
valText (Local LocalTime
l) = LocalTime -> Text
forall a. Show a => a -> Text
showText LocalTime
l
valText (Day Day
d) = Day -> Text
forall a. Show a => a -> Text
showText Day
d
valText (Hours TimeOfDay
h) = TimeOfDay -> Text
forall a. Show a => a -> Text
showText TimeOfDay
h
valText (Array [Value t1]
a) = PrintOptions -> (Value t1 -> Text) -> [Value t1] -> Text
forall (t :: TValue).
PrintOptions -> (Value t -> Text) -> [Value t] -> Text
withLines PrintOptions
options Value t1 -> Text
forall (t :: TValue). Value t -> Text
valText [Value t1]
a
showText :: Show a => a -> Text
showText :: forall a. Show a => a -> Text
showText = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
showTextUnicode :: Text -> Text
showTextUnicode :: Text -> Text
showTextUnicode Text
text = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
finalText
where
xss :: String
xss = Text -> String
Text.unpack Text
text
finalText :: String
finalText = (String -> (Char, Bool) -> String)
-> String -> [(Char, Bool)] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\String
acc (Char
ch, Bool
asciiCh) -> String
acc String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> Bool -> String
getCh Char
ch Bool
asciiCh) String
"" [(Char, Bool)]
asciiArr
asciiArr :: [(Char, Bool)]
asciiArr = String -> [Bool] -> [(Char, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
xss ([Bool] -> [(Char, Bool)]) -> [Bool] -> [(Char, Bool)]
forall a b. (a -> b) -> a -> b
$ String -> [Bool]
asciiStatus String
xss
getCh :: Char -> Bool -> String
getCh :: Char -> Bool -> String
getCh Char
ch Bool
True = [Char
ch]
getCh Char
ch Bool
False = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\U%08x" (Char -> Int
ord Char
ch) :: String
asciiStatus :: String -> [Bool]
asciiStatus :: String -> [Bool]
asciiStatus = (Char -> Bool) -> String -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Bool
isAscii
showDouble :: Double -> Text
showDouble :: Double -> Text
showDouble Double
d | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Text
"-inf"
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d = Text
"inf"
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d = Text
"nan"
| Bool
otherwise = Double -> Text
forall a. Show a => a -> Text
showText Double
d
showZonedTime :: ZonedTime -> Text
showZonedTime :: ZonedTime -> Text
showZonedTime ZonedTime
t = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ZonedTime -> String
showZonedDateTime ZonedTime
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ZonedTime -> String
showZonedZone ZonedTime
t
where
showZonedDateTime :: ZonedTime -> String
showZonedDateTime = TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%T%Q"
showZonedZone :: ZonedTime -> String
showZonedZone
= (\(String
x,String
y) -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y)
((String, String) -> String)
-> (ZonedTime -> (String, String)) -> ZonedTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
z -> Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
z)
(String -> (String, String))
-> (ZonedTime -> String) -> ZonedTime -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%z"
prettyTables :: PrintOptions -> Int -> Text -> PrefixMap TOML -> [Text]
prettyTables :: PrintOptions -> Int -> Text -> PrefixMap TOML -> [Text]
prettyTables PrintOptions
options Int
i Text
pref PrefixMap TOML
asPieces = ((Key, PrefixTree TOML) -> [Text])
-> PrintOptions -> [(Key, PrefixTree TOML)] -> [Text]
forall v t. ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]
mapOrdered (PrefixTree TOML -> [Text]
prettyTable (PrefixTree TOML -> [Text])
-> ((Key, PrefixTree TOML) -> PrefixTree TOML)
-> (Key, PrefixTree TOML)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, PrefixTree TOML) -> PrefixTree TOML
forall a b. (a, b) -> b
snd) PrintOptions
options [(Key, PrefixTree TOML)]
asKeys
where
asKeys :: [(Key, PrefixTree TOML)]
asKeys :: [(Key, PrefixTree TOML)]
asKeys = ((Piece, PrefixTree TOML) -> (Key, PrefixTree TOML))
-> [(Piece, PrefixTree TOML)] -> [(Key, PrefixTree TOML)]
forall a b. (a -> b) -> [a] -> [b]
map ((Piece -> Key)
-> (Piece, PrefixTree TOML) -> (Key, PrefixTree TOML)
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 Piece -> Key
pieceToKey) ([(Piece, PrefixTree TOML)] -> [(Key, PrefixTree TOML)])
-> [(Piece, PrefixTree TOML)] -> [(Key, PrefixTree TOML)]
forall a b. (a -> b) -> a -> b
$ PrefixMap TOML -> [(Piece, PrefixTree TOML)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList PrefixMap TOML
asPieces
pieceToKey :: Piece -> Key
pieceToKey :: Piece -> Key
pieceToKey = NonEmpty Piece -> Key
Key (NonEmpty Piece -> Key)
-> (Piece -> NonEmpty Piece) -> Piece -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> NonEmpty Piece
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
prettyTable :: PrefixTree TOML -> [Text]
prettyTable :: PrefixTree TOML -> [Text]
prettyTable (Leaf Key
k TOML
toml) =
let name :: Text
name = Key -> Text -> Text
addPrefix Key
k Text
pref
in Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: PrintOptions -> Int -> Text
tabWith PrintOptions
options Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
prettyTableName Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (PrintOptions -> Int -> Text -> TOML -> [Text]
prettyTomlInd PrintOptions
options (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
name TOML
toml)
prettyTable (Branch Key
k Maybe TOML
mToml PrefixMap TOML
prefMap) =
let name :: Text
name = Key -> Text -> Text
addPrefix Key
k Text
pref
nextI :: Int
nextI = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
toml :: [Text]
toml = case Maybe TOML
mToml of
Maybe TOML
Nothing -> []
Just TOML
t -> PrintOptions -> Int -> Text -> TOML -> [Text]
prettyTomlInd PrintOptions
options Int
nextI Text
name TOML
t
in Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: PrintOptions -> Int -> Text
tabWith PrintOptions
options Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
prettyTableName Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") ([Text]
toml [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ PrintOptions -> Int -> Text -> PrefixMap TOML -> [Text]
prettyTables PrintOptions
options Int
nextI Text
name PrefixMap TOML
prefMap)
prettyTableName :: Text -> Text
prettyTableName :: Text -> Text
prettyTableName Text
n = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
prettyTableArrays :: PrintOptions -> Int -> Text -> HashMap Key (NonEmpty TOML) -> [Text]
prettyTableArrays :: PrintOptions
-> Int -> Text -> HashMap Key (NonEmpty TOML) -> [Text]
prettyTableArrays PrintOptions
options Int
i Text
pref = ((Key, NonEmpty TOML) -> [Text])
-> PrintOptions -> [(Key, NonEmpty TOML)] -> [Text]
forall v t. ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]
mapOrdered (Key, NonEmpty TOML) -> [Text]
arrText PrintOptions
options ([(Key, NonEmpty TOML)] -> [Text])
-> (HashMap Key (NonEmpty TOML) -> [(Key, NonEmpty TOML)])
-> HashMap Key (NonEmpty TOML)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Key (NonEmpty TOML) -> [(Key, NonEmpty TOML)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
where
arrText :: (Key, NonEmpty TOML) -> [Text]
arrText :: (Key, NonEmpty TOML) -> [Text]
arrText (Key
k, NonEmpty TOML
ne) =
let name :: Text
name = Key -> Text -> Text
addPrefix Key
k Text
pref
render :: TOML -> [Text]
render TOML
toml =
Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: PrintOptions -> Int -> Text
tabWith PrintOptions
options Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (PrintOptions -> Int -> Text -> TOML -> [Text]
prettyTomlInd PrintOptions
options (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
name TOML
toml)
in (TOML -> [Text]) -> [TOML] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TOML -> [Text]
render ([TOML] -> [Text]) -> [TOML] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty TOML
ne
tabWith :: PrintOptions -> Int -> Text
tabWith :: PrintOptions -> Int -> Text
tabWith PrintOptions{Int
Maybe (Key -> Key -> Ordering)
Lines
printOptionsSorting :: PrintOptions -> Maybe (Key -> Key -> Ordering)
printOptionsIndent :: PrintOptions -> Int
printOptionsLines :: PrintOptions -> Lines
printOptionsSorting :: Maybe (Key -> Key -> Ordering)
printOptionsIndent :: Int
printOptionsLines :: Lines
..} Int
n = Int -> Text -> Text
Text.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
printOptionsIndent) Text
" "
mapOrdered :: ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]
mapOrdered :: forall v t. ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]
mapOrdered (Key, v) -> [t]
f PrintOptions
options = case PrintOptions -> Maybe (Key -> Key -> Ordering)
printOptionsSorting PrintOptions
options of
Just Key -> Key -> Ordering
sorter -> ((Key, v) -> [t]) -> [(Key, v)] -> [t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Key, v) -> [t]
f ([(Key, v)] -> [t])
-> ([(Key, v)] -> [(Key, v)]) -> [(Key, v)] -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, v) -> (Key, v) -> Ordering) -> [(Key, v)] -> [(Key, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Key -> Key -> Ordering
sorter (Key -> Key -> Ordering)
-> ((Key, v) -> Key) -> (Key, v) -> (Key, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Key, v) -> Key
forall a b. (a, b) -> a
fst)
Maybe (Key -> Key -> Ordering)
Nothing -> ((Key, v) -> [t]) -> [(Key, v)] -> [t]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Key, v) -> [t]
f ([(Key, v)] -> [t])
-> ([(Key, v)] -> [(Key, v)]) -> [(Key, v)] -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, v) -> Key) -> [(Key, v)] -> [(Key, v)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Key, v) -> Key
forall a b. (a, b) -> a
fst
addPrefix :: Key -> Text -> Text
addPrefix :: Key -> Text -> Text
addPrefix Key
key = \case
Text
"" -> Key -> Text
prettyKey Key
key
Text
prefix -> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
prettyKey Key
key
withLines :: PrintOptions -> (Value t -> Text) -> [Value t] -> Text
withLines :: forall (t :: TValue).
PrintOptions -> (Value t -> Text) -> [Value t] -> Text
withLines PrintOptions{Int
Maybe (Key -> Key -> Ordering)
Lines
printOptionsSorting :: PrintOptions -> Maybe (Key -> Key -> Ordering)
printOptionsIndent :: PrintOptions -> Int
printOptionsLines :: PrintOptions -> Lines
printOptionsSorting :: Maybe (Key -> Key -> Ordering)
printOptionsIndent :: Int
printOptionsLines :: Lines
..} Value t -> Text
valTxt [Value t]
a = case Lines
printOptionsLines of
Lines
OneLine -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " ((Value t -> Text) -> [Value t] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value t -> Text
valTxt [Value t]
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
Lines
MultiLine -> Text
off Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate (Text
off Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", ") ((Value t -> Text) -> [Value t] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value t -> Text
valTxt [Value t]
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
off Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
where
off :: Text
off :: Text
off = Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
forall b. Integral b => b -> Text -> Text
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
printOptionsIndent Text
" "