{-# Language OverloadedStrings, GADTs #-}
{-|
Module      : Toml.Pretty
Description : Human-readable representations for error messages
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module provides human-readable renderers for types used
in this package to assist error message production.

The generated 'Doc' values are annotated with 'DocClass' values
to assist in producing syntax-highlighted outputs.

To extract a plain String representation, use 'show'.

-}
module Toml.Pretty (
    -- * Types
    TomlDoc,
    DocClass(..),

    -- * Printing semantic values
    prettyToml,
    prettyTomlOrdered,
    prettyValue,

    -- * Printing syntactic components
    prettyToken,
    prettySectionKind,

    -- * Printing keys
    prettySimpleKey,
    prettyKey,
    ) where

import Data.Char (ord, isAsciiLower, isAsciiUpper, isDigit, isPrint)
import Data.Foldable (fold)
import Data.List (partition, sortOn)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.String (fromString)
import Data.Time (ZonedTime(zonedTimeZone), TimeZone (timeZoneMinutes))
import Data.Time.Format (formatTime, defaultTimeLocale)
import Prettyprinter
import Text.Printf (printf)
import Toml.Parser (SectionKind(..))
import Toml.Lexer (Token(..))
import Toml.Value (Value(..), Table)

-- | Annotation used to enable styling pretty-printed TOML
data DocClass
    = TableClass  -- ^ top-level @[key]@ and @[[key]]@
    | KeyClass    -- ^ dotted keys, left-hand side of assignments
    | StringClass -- ^ string literals
    | NumberClass -- ^ number literals
    | DateClass   -- ^ date and time literals
    | BoolClass   -- ^ boolean literals
    deriving (ReadPrec [DocClass]
ReadPrec DocClass
Int -> ReadS DocClass
ReadS [DocClass]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocClass]
$creadListPrec :: ReadPrec [DocClass]
readPrec :: ReadPrec DocClass
$creadPrec :: ReadPrec DocClass
readList :: ReadS [DocClass]
$creadList :: ReadS [DocClass]
readsPrec :: Int -> ReadS DocClass
$creadsPrec :: Int -> ReadS DocClass
Read, Int -> DocClass -> ShowS
[DocClass] -> ShowS
DocClass -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DocClass] -> ShowS
$cshowList :: [DocClass] -> ShowS
show :: DocClass -> [Char]
$cshow :: DocClass -> [Char]
showsPrec :: Int -> DocClass -> ShowS
$cshowsPrec :: Int -> DocClass -> ShowS
Show, DocClass -> DocClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocClass -> DocClass -> Bool
$c/= :: DocClass -> DocClass -> Bool
== :: DocClass -> DocClass -> Bool
$c== :: DocClass -> DocClass -> Bool
Eq, Eq DocClass
DocClass -> DocClass -> Bool
DocClass -> DocClass -> Ordering
DocClass -> DocClass -> DocClass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DocClass -> DocClass -> DocClass
$cmin :: DocClass -> DocClass -> DocClass
max :: DocClass -> DocClass -> DocClass
$cmax :: DocClass -> DocClass -> DocClass
>= :: DocClass -> DocClass -> Bool
$c>= :: DocClass -> DocClass -> Bool
> :: DocClass -> DocClass -> Bool
$c> :: DocClass -> DocClass -> Bool
<= :: DocClass -> DocClass -> Bool
$c<= :: DocClass -> DocClass -> Bool
< :: DocClass -> DocClass -> Bool
$c< :: DocClass -> DocClass -> Bool
compare :: DocClass -> DocClass -> Ordering
$ccompare :: DocClass -> DocClass -> Ordering
Ord)

-- | Pretty-printer document with TOML class attributes to aid
-- in syntax-highlighting.
type TomlDoc = Doc DocClass

-- | Renders a dotted-key using quotes where necessary and annotated
-- as a 'KeyClass'.
prettyKey :: NonEmpty String -> TomlDoc
prettyKey :: NonEmpty [Char] -> Doc DocClass
prettyKey = forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
KeyClass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse forall ann. Doc ann
dot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Char] -> Doc a
prettySimpleKey

-- | Renders a simple-key using quotes where necessary.
prettySimpleKey :: String -> Doc a
prettySimpleKey :: forall a. [Char] -> Doc a
prettySimpleKey [Char]
str
    | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
str), forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isBareKey [Char]
str = forall a. IsString a => [Char] -> a
fromString [Char]
str
    | Bool
otherwise                         = forall a. IsString a => [Char] -> a
fromString (ShowS
quoteString [Char]
str)

-- | Predicate for the character-class that is allowed in bare keys
isBareKey :: Char -> Bool
isBareKey :: Char -> Bool
isBareKey Char
x = Char -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_'

-- | Quote a string using basic string literal syntax.
quoteString :: String -> String
quoteString :: ShowS
quoteString = (Char
'"'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go
    where
        go :: ShowS
go = \case
            [Char]
""        -> [Char]
"\"" -- terminator
            Char
'"'  : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'"'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\\' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\\' forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\b' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'b'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\f' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'f'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\n' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'n'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\r' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'r'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
'\t' : [Char]
xs -> Char
'\\' forall a. a -> [a] -> [a]
: Char
't'  forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
            Char
x    : [Char]
xs
                | Char -> Bool
isPrint Char
x     -> Char
x forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
                | Char
x forall a. Ord a => a -> a -> Bool
<= Char
'\xffff' -> forall r. PrintfType r => [Char] -> r
printf [Char]
"\\u%04X%s" (Char -> Int
ord Char
x) (ShowS
go [Char]
xs)
                | Bool
otherwise     -> forall r. PrintfType r => [Char] -> r
printf [Char]
"\\U%08X%s" (Char -> Int
ord Char
x) (ShowS
go [Char]
xs)

-- | Pretty-print a section heading. The result is annotated as a 'TableClass'.
prettySectionKind :: SectionKind -> NonEmpty String -> TomlDoc
prettySectionKind :: SectionKind -> NonEmpty [Char] -> Doc DocClass
prettySectionKind SectionKind
TableKind      NonEmpty [Char]
key =
    forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
TableClass (forall ann xxx. Doc ann -> Doc xxx
unAnnotate (forall ann. Doc ann
lbracket forall a. Semigroup a => a -> a -> a
<> NonEmpty [Char] -> Doc DocClass
prettyKey NonEmpty [Char]
key forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbracket))
prettySectionKind SectionKind
ArrayTableKind NonEmpty [Char]
key =
    forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
TableClass (forall ann xxx. Doc ann -> Doc xxx
unAnnotate (forall ann. Doc ann
lbracket forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
lbracket forall a. Semigroup a => a -> a -> a
<> NonEmpty [Char] -> Doc DocClass
prettyKey NonEmpty [Char]
key forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbracket forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbracket))

-- | Render token for human-readable error messages.
prettyToken :: Token -> String
prettyToken :: Token -> [Char]
prettyToken = \case
    Token
TokComma            -> [Char]
"','"
    Token
TokEquals           -> [Char]
"'='"
    Token
TokPeriod           -> [Char]
"'.'"
    Token
TokSquareO          -> [Char]
"'['"
    Token
TokSquareC          -> [Char]
"']'"
    Token
Tok2SquareO         -> [Char]
"'[['"
    Token
Tok2SquareC         -> [Char]
"']]'"
    Token
TokCurlyO           -> [Char]
"'{'"
    Token
TokCurlyC           -> [Char]
"'}'"
    Token
TokNewline          -> [Char]
"newline"
    TokBareKey        [Char]
_ -> [Char]
"bare key"
    Token
TokTrue             -> [Char]
"true literal"
    Token
TokFalse            -> [Char]
"false literal"
    TokString         [Char]
_ -> [Char]
"string"
    TokMlString       [Char]
_ -> [Char]
"multi-line string"
    TokInteger        Integer
_ -> [Char]
"integer"
    TokFloat          Double
_ -> [Char]
"float"
    TokOffsetDateTime ZonedTime
_ -> [Char]
"offset date-time"
    TokLocalDateTime  LocalTime
_ -> [Char]
"local date-time"
    TokLocalDate      Day
_ -> [Char]
"local date"
    TokLocalTime      TimeOfDay
_ -> [Char]
"local time"
    TokError          [Char]
e -> [Char]
"lexical error: " forall a. [a] -> [a] -> [a]
++ [Char]
e
    Token
TokEOF              -> [Char]
"end-of-input"

prettyAssignment :: String -> Value -> TomlDoc
prettyAssignment :: [Char] -> Value -> Doc DocClass
prettyAssignment = NonEmpty [Char] -> Value -> Doc DocClass
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    where
        go :: NonEmpty [Char] -> Value -> Doc DocClass
go NonEmpty [Char]
ks (Table (forall k a. Map k a -> [(k, a)]
Map.assocs -> [([Char]
k,Value
v)])) = NonEmpty [Char] -> Value -> Doc DocClass
go (forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons [Char]
k NonEmpty [Char]
ks) Value
v
        go NonEmpty [Char]
ks Value
v = NonEmpty [Char] -> Doc DocClass
prettyKey (forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse NonEmpty [Char]
ks) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
equals forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc DocClass
prettyValue Value
v

-- | Render a value suitable for assignment on the right-hand side
-- of an equals sign. This value will always use inline table and list
-- syntax.
prettyValue :: Value -> TomlDoc
prettyValue :: Value -> Doc DocClass
prettyValue = \case
    Integer Integer
i           -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
NumberClass (forall a ann. Pretty a => a -> Doc ann
pretty Integer
i)
    Float   Double
f
        | forall a. RealFloat a => a -> Bool
isNaN Double
f       -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
NumberClass Doc DocClass
"nan"
        | forall a. RealFloat a => a -> Bool
isInfinite Double
f  -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
NumberClass (if Double
f forall a. Ord a => a -> a -> Bool
> Double
0 then Doc DocClass
"inf" else Doc DocClass
"-inf")
        | Bool
otherwise     -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
NumberClass (forall a ann. Pretty a => a -> Doc ann
pretty Double
f)
    Array [Value]
a             -> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
list [Value -> Doc DocClass
prettyValue Value
v | Value
v <- [Value]
a])
    Table Table
t             -> forall ann. Doc ann
lbrace forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
surround Doc DocClass
", ") [[Char] -> Value -> Doc DocClass
prettyAssignment [Char]
k Value
v | ([Char]
k,Value
v) <- forall k a. Map k a -> [(k, a)]
Map.assocs Table
t] forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rbrace
    Bool Bool
True           -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
BoolClass Doc DocClass
"true"
    Bool Bool
False          -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
BoolClass Doc DocClass
"false"
    String [Char]
str          -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
StringClass (forall a. IsString a => [Char] -> a
fromString (ShowS
quoteString [Char]
str))
    TimeOfDay TimeOfDay
tod       -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
DateClass (forall a. IsString a => [Char] -> a
fromString (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%H:%M:%S%Q" TimeOfDay
tod))
    ZonedTime ZonedTime
zt
        | TimeZone -> Int
timeZoneMinutes (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
zt) forall a. Eq a => a -> a -> Bool
== Int
0 ->
                           forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
DateClass (forall a. IsString a => [Char] -> a
fromString (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%dT%H:%M:%S%QZ" ZonedTime
zt))
        | Bool
otherwise     -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
DateClass (forall a. IsString a => [Char] -> a
fromString (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%dT%H:%M:%S%Q%Ez" ZonedTime
zt))
    LocalTime LocalTime
lt        -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
DateClass (forall a. IsString a => [Char] -> a
fromString (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%dT%H:%M:%S%Q" LocalTime
lt))
    Day Day
d               -> forall ann. ann -> Doc ann -> Doc ann
annotate DocClass
DateClass (forall a. IsString a => [Char] -> a
fromString (forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%d" Day
d))

isAlwaysSimple :: Value -> Bool
isAlwaysSimple :: Value -> Bool
isAlwaysSimple = \case
    Integer   Integer
_ -> Bool
True
    Float     Double
_ -> Bool
True
    Bool      Bool
_ -> Bool
True
    String    [Char]
_ -> Bool
True
    TimeOfDay TimeOfDay
_ -> Bool
True
    ZonedTime ZonedTime
_ -> Bool
True
    LocalTime LocalTime
_ -> Bool
True
    Day       Day
_ -> Bool
True
    Table     Table
x -> Table -> Bool
isSingularTable Table
x
    Array     [Value]
x -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
x Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isTable [Value]
x)

isTable :: Value -> Bool
isTable :: Value -> Bool
isTable Table {} = Bool
True
isTable Value
_        = Bool
False

isSingularTable :: Table -> Bool
isSingularTable :: Table -> Bool
isSingularTable (forall k a. Map k a -> [a]
Map.elems -> [Value
v])  = Value -> Bool
isAlwaysSimple Value
v
isSingularTable Table
_                   = Bool
False

-- | Render a complete TOML document using top-level table and array of
-- table sections where possible.
--
-- Keys are sorted alphabetically. To provide a custom ordering, see
-- 'prettyTomlOrdered'.
prettyToml ::
    Table {- ^ table to print -} ->
    TomlDoc {- ^ TOML syntax -}
prettyToml :: Table -> Doc DocClass
prettyToml = KeyProjection -> SectionKind -> [[Char]] -> Table -> Doc DocClass
prettyToml_ KeyProjection
NoProjection SectionKind
TableKind []

-- | Render a complete TOML document like 'prettyToml' but use a
-- custom key ordering. The comparison function has access to the
-- complete key path. Note that only keys in the same table will
-- every be compared.
--
-- This operation allows you to render your TOML files with the
-- most important sections first. A TOML file describing a package
-- might desire to have the @[package]@ section first before any
-- of the ancilliary configuration sections.
--
-- The /table path/ is the name of the table being sorted. This allows
-- the projection to be aware of which table is being sorted.
--
-- The /key/ is the key in the table being sorted. These are the
-- keys that will be compared to each other.
--
-- Here's a projection that puts the @package@ section first, the
-- @secondary@ section second, and then all remaining cases are
-- sorted alphabetically afterward.
--
-- @
-- example :: [String] -> String -> Either Int String
-- example [] "package" = Left 1
-- example [] "second"  = Left 2
-- example _  other     = Right other
-- @
--
-- We could also put the tables in reverse-alphabetical order
-- by leveraging an existing newtype.
--
-- @
-- reverseOrderProj :: [String] -> String -> Down String
-- reverseOrderProj _ = Down
-- @
--
-- @since 1.2.1.0
prettyTomlOrdered ::
  Ord a =>
  ([String] -> String -> a) {- ^ table path -> key -> projection -} ->
  Table {- ^ table to print -} ->
  TomlDoc {- ^ TOML syntax -}
prettyTomlOrdered :: forall a.
Ord a =>
([[Char]] -> [Char] -> a) -> Table -> Doc DocClass
prettyTomlOrdered [[Char]] -> [Char] -> a
proj = KeyProjection -> SectionKind -> [[Char]] -> Table -> Doc DocClass
prettyToml_ (forall a. Ord a => ([[Char]] -> [Char] -> a) -> KeyProjection
KeyProjection [[Char]] -> [Char] -> a
proj) SectionKind
TableKind []

-- | Optional projection used to order rendered tables
data KeyProjection where
    -- | No projection provided; alphabetical order used
    NoProjection :: KeyProjection
    -- | Projection provided: table name and current key are available
    KeyProjection :: Ord a => ([String] -> String -> a) -> KeyProjection

prettyToml_ :: KeyProjection -> SectionKind -> [String] -> Table -> TomlDoc
prettyToml_ :: KeyProjection -> SectionKind -> [[Char]] -> Table -> Doc DocClass
prettyToml_ KeyProjection
mbKeyProj SectionKind
kind [[Char]]
prefix Table
t = forall ann. [Doc ann] -> Doc ann
vcat ([Doc DocClass]
topLines forall a. [a] -> [a] -> [a]
++ [Doc DocClass]
subtables)
    where
        order :: [([Char], Value)] -> [([Char], Value)]
order =
            case KeyProjection
mbKeyProj of
                KeyProjection
NoProjection    -> forall a. a -> a
id
                KeyProjection [[Char]] -> [Char] -> a
f -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ([[Char]] -> [Char] -> a
f [[Char]]
prefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

        ([([Char], Value)]
simple, [([Char], Value)]
sections) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Value -> Bool
isAlwaysSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) ([([Char], Value)] -> [([Char], Value)]
order (forall k a. Map k a -> [(k, a)]
Map.assocs Table
t))

        topLines :: [Doc DocClass]
topLines = [forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Doc DocClass]
topElts | let topElts :: [Doc DocClass]
topElts = [Doc DocClass]
headers forall a. [a] -> [a] -> [a]
++ [Doc DocClass]
assignments, Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc DocClass]
topElts)]

        headers :: [Doc DocClass]
headers =
            case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [[Char]]
prefix of
                Just NonEmpty [Char]
key | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Value)]
simple) Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Value)]
sections Bool -> Bool -> Bool
|| SectionKind
kind forall a. Eq a => a -> a -> Bool
== SectionKind
ArrayTableKind ->
                    [SectionKind -> NonEmpty [Char] -> Doc DocClass
prettySectionKind SectionKind
kind NonEmpty [Char]
key forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline]
                Maybe (NonEmpty [Char])
_ -> []

        assignments :: [Doc DocClass]
assignments = [[Char] -> Value -> Doc DocClass
prettyAssignment [Char]
k Value
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline | ([Char]
k,Value
v) <- [([Char], Value)]
simple]

        subtables :: [Doc DocClass]
subtables = [NonEmpty [Char] -> Value -> Doc DocClass
prettySection ([[Char]]
prefix forall a. [a] -> a -> NonEmpty a
`snoc` [Char]
k) Value
v | ([Char]
k,Value
v) <- [([Char], Value)]
sections]

        prettySection :: NonEmpty [Char] -> Value -> Doc DocClass
prettySection NonEmpty [Char]
key (Table Table
t) =
            KeyProjection -> SectionKind -> [[Char]] -> Table -> Doc DocClass
prettyToml_ KeyProjection
mbKeyProj SectionKind
TableKind (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty [Char]
key) Table
t
        prettySection NonEmpty [Char]
key (Array [Value]
a) =
            forall ann. [Doc ann] -> Doc ann
vcat [KeyProjection -> SectionKind -> [[Char]] -> Table -> Doc DocClass
prettyToml_ KeyProjection
mbKeyProj SectionKind
ArrayTableKind (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty [Char]
key) Table
t | Table Table
t <- [Value]
a]
        prettySection NonEmpty [Char]
_ Value
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"prettySection applied to simple value"

-- | Create a 'NonEmpty' with a given prefix and last element.
snoc :: [a] -> a -> NonEmpty a
snoc :: forall a. [a] -> a -> NonEmpty a
snoc []       a
y = a
y forall a. a -> [a] -> NonEmpty a
:| []
snoc (a
x : [a]
xs) a
y = a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs forall a. [a] -> [a] -> [a]
++ [a
y]