    {-# 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,

        -- * Locations
        prettyLocated,
        prettyPosition,
        ) 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.Text (Text)
    import Data.Text qualified as Text
    import Data.Time (ZonedTime(zonedTimeZone), TimeZone (timeZoneMinutes))
    import Data.Time.Format (formatTime, defaultTimeLocale)
    import Prettyprinter
    import Text.Printf (printf)
    import Toml.Semantics
    import Toml.Syntax.Lexer (Token(..))
    import Toml.Syntax.Position (Located(..), Position(..))
    import Toml.Syntax.Types (SectionKind(..))

    -- | 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]
    (Int -> ReadS DocClass)
    -> ReadS [DocClass]
    -> ReadPrec DocClass
    -> ReadPrec [DocClass]
    -> Read DocClass
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS DocClass
    readsPrec :: Int -> ReadS DocClass
    $creadList :: ReadS [DocClass]
    readList :: ReadS [DocClass]
    $creadPrec :: ReadPrec DocClass
    readPrec :: ReadPrec DocClass
    $creadListPrec :: ReadPrec [DocClass]
    readListPrec :: ReadPrec [DocClass]
    Read, Int -> DocClass -> String -> String
    [DocClass] -> String -> String
    DocClass -> String
    (Int -> DocClass -> String -> String)
    -> (DocClass -> String)
    -> ([DocClass] -> String -> String)
    -> Show DocClass
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DocClass -> String -> String
    showsPrec :: Int -> DocClass -> String -> String
    $cshow :: DocClass -> String
    show :: DocClass -> String
    $cshowList :: [DocClass] -> String -> String
    showList :: [DocClass] -> String -> String
    Show, DocClass -> DocClass -> Bool
    (DocClass -> DocClass -> Bool)
    -> (DocClass -> DocClass -> Bool) -> Eq DocClass
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DocClass -> DocClass -> Bool
    == :: DocClass -> DocClass -> Bool
    $c/= :: DocClass -> DocClass -> Bool
    /= :: DocClass -> DocClass -> Bool
    Eq, Eq DocClass
    Eq DocClass =>
    (DocClass -> DocClass -> Ordering)
    -> (DocClass -> DocClass -> Bool)
    -> (DocClass -> DocClass -> Bool)
    -> (DocClass -> DocClass -> Bool)
    -> (DocClass -> DocClass -> Bool)
    -> (DocClass -> DocClass -> DocClass)
    -> (DocClass -> DocClass -> DocClass)
    -> Ord 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
    $ccompare :: DocClass -> DocClass -> Ordering
    compare :: DocClass -> DocClass -> Ordering
    $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
    >= :: DocClass -> DocClass -> Bool
    $cmax :: DocClass -> DocClass -> DocClass
    max :: DocClass -> DocClass -> DocClass
    $cmin :: DocClass -> DocClass -> DocClass
    min :: DocClass -> DocClass -> DocClass
    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 Text -> TomlDoc
    prettyKey :: NonEmpty Text -> Doc DocClass
    prettyKey = DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    KeyClass (Doc DocClass -> Doc DocClass)
    -> (NonEmpty Text -> Doc DocClass) -> NonEmpty Text -> Doc DocClass
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty (Doc DocClass) -> Doc DocClass
    forall m. Monoid m => NonEmpty m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold (NonEmpty (Doc DocClass) -> Doc DocClass)
    -> (NonEmpty Text -> NonEmpty (Doc DocClass))
    -> NonEmpty Text
    -> Doc DocClass
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc DocClass -> NonEmpty (Doc DocClass) -> NonEmpty (Doc DocClass)
    forall a. a -> NonEmpty a -> NonEmpty a
    NonEmpty.intersperse Doc DocClass
    forall ann. Doc ann
    dot (NonEmpty (Doc DocClass) -> NonEmpty (Doc DocClass))
    -> (NonEmpty Text -> NonEmpty (Doc DocClass))
    -> NonEmpty Text
    -> NonEmpty (Doc DocClass)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Doc DocClass) -> NonEmpty Text -> NonEmpty (Doc DocClass)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Doc DocClass
    forall a. Text -> Doc a
    prettySimpleKey

    -- | Renders a simple-key using quotes where necessary.
    prettySimpleKey :: Text -> Doc a
    prettySimpleKey :: forall a. Text -> Doc a
    prettySimpleKey Text
    str
        | Bool -> Bool
    not (Text -> Bool
    Text.null Text
    str), (Char -> Bool) -> Text -> Bool
    Text.all Char -> Bool
    isBareKey Text
    str = Text -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall a. Text -> Doc a
    pretty Text
    str
        | Bool
    otherwise = String -> Doc a
    forall a. IsString a => String -> a
    fromString (String -> String
    quoteString (Text -> String
    Text.unpack Text
    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 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'

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

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

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

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

    prettyAssignment :: Text -> Value' l -> TomlDoc
    prettyAssignment :: forall l. Text -> Value' l -> Doc DocClass
    prettyAssignment = NonEmpty Text -> Value' l -> Doc DocClass
    forall {l}. NonEmpty Text -> Value' l -> Doc DocClass
    go (NonEmpty Text -> Value' l -> Doc DocClass)
    -> (Text -> NonEmpty Text) -> Text -> Value' l -> Doc DocClass
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> NonEmpty Text
    forall a. a -> NonEmpty a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        where
            go :: NonEmpty Text -> Value' l -> Doc DocClass
    go NonEmpty Text
    ks (Table' l
    _ (MkTable (Map Text (l, Value' l) -> [(Text, (l, Value' l))]
    forall k a. Map k a -> [(k, a)]
    Map.assocs -> [(Text
    k,(l
    _, Value' l
    v))]))) = NonEmpty Text -> Value' l -> Doc DocClass
    go (Text -> NonEmpty Text -> NonEmpty Text
    forall a. a -> NonEmpty a -> NonEmpty a
    NonEmpty.cons Text
    k NonEmpty Text
    ks) Value' l
    v
            go NonEmpty Text
    ks Value' l
    v = NonEmpty Text -> Doc DocClass
    prettyKey (NonEmpty Text -> NonEmpty Text
    forall a. NonEmpty a -> NonEmpty a
    NonEmpty.reverse NonEmpty Text
    ks) Doc DocClass -> Doc DocClass -> Doc DocClass
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc DocClass
    forall ann. Doc ann
    equals Doc DocClass -> Doc DocClass -> Doc DocClass
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Value' l -> Doc DocClass
    forall l. Value' l -> Doc DocClass
    prettyValue Value' l
    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' l -> TomlDoc
    prettyValue :: forall l. Value' l -> Doc DocClass
    prettyValue = \case
        Integer' l
    _ Integer
    i           -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    NumberClass (Integer -> Doc DocClass
    forall ann. Integer -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Integer
    i)
        Double' l
    _   Double
    f
            | Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    f       -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    NumberClass Doc DocClass
    "nan"
            | Double -> Bool
    forall a. RealFloat a => a -> Bool
    isInfinite Double
    f  -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    NumberClass (if Double
    f Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    0 then Doc DocClass
    "inf" else Doc DocClass
    "-inf")
            | Bool
    otherwise     -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    NumberClass (Double -> Doc DocClass
    forall ann. Double -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Double
    f)
        List' l
    _ [Value' l]
    a           -> Doc DocClass -> Doc DocClass
    forall ann. Doc ann -> Doc ann
    align ([Doc DocClass] -> Doc DocClass
    forall ann. [Doc ann] -> Doc ann
    list [Value' l -> Doc DocClass
    forall l. Value' l -> Doc DocClass
    prettyValue Value' l
    v | Value' l
    v <- [Value' l]
    a])
        Table' l
    _ (MkTable Map Text (l, Value' l)
    t) -> Doc DocClass
    forall ann. Doc ann
    lbrace Doc DocClass -> Doc DocClass -> Doc DocClass
    forall a. Semigroup a => a -> a -> a
    <> (Doc DocClass -> Doc DocClass -> Doc DocClass)
    -> [Doc DocClass] -> Doc DocClass
    forall (t :: * -> *) ann.
    Foldable t =>
    (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
    concatWith (Doc DocClass -> Doc DocClass -> Doc DocClass -> Doc DocClass
    forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
    surround Doc DocClass
    ", ") [Text -> Value' l -> Doc DocClass
    forall l. Text -> Value' l -> Doc DocClass
    prettyAssignment Text
    k Value' l
    v | (Text
    k,(l
    _, Value' l
    v)) <- Map Text (l, Value' l) -> [(Text, (l, Value' l))]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map Text (l, Value' l)
    t] Doc DocClass -> Doc DocClass -> Doc DocClass
    forall a. Semigroup a => a -> a -> a
    <> Doc DocClass
    forall ann. Doc ann
    rbrace
        Bool' l
    _ Bool
    True        -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    BoolClass Doc DocClass
    "true"
        Bool' l
    _ Bool
    False       -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    BoolClass Doc DocClass
    "false"
        Text' l
    _ Text
    str         -> Text -> Doc DocClass
    prettySmartString Text
    str
        TimeOfDay' l
    _ TimeOfDay
    tod    -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    DateClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (TimeLocale -> String -> TimeOfDay -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%H:%M:%S%Q" TimeOfDay
    tod))
        ZonedTime' l
    _ ZonedTime
    zt
            | TimeZone -> Int
    timeZoneMinutes (ZonedTime -> TimeZone
    zonedTimeZone ZonedTime
    zt) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 ->
                               DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    DateClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (TimeLocale -> String -> ZonedTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%0Y-%m-%dT%H:%M:%S%QZ" ZonedTime
    zt))
            | Bool
    otherwise     -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    DateClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (TimeLocale -> String -> ZonedTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%0Y-%m-%dT%H:%M:%S%Q%Ez" ZonedTime
    zt))
        LocalTime' l
    _ LocalTime
    lt     -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    DateClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (TimeLocale -> String -> LocalTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%0Y-%m-%dT%H:%M:%S%Q" LocalTime
    lt))
        Day' l
    _ Day
    d            -> DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    DateClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%0Y-%m-%d" Day
    d))

    prettySmartString :: Text -> TomlDoc
    prettySmartString :: Text -> Doc DocClass
    prettySmartString Text
    str
        | Char
    '\n' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Text -> String
    Text.unpack Text
    str = -- Text.elem isn't in text-1.2
            (Int -> Doc DocClass) -> Doc DocClass
    forall ann. (Int -> Doc ann) -> Doc ann
    column \Int
    i ->
            (PageWidth -> Doc DocClass) -> Doc DocClass
    forall ann. (PageWidth -> Doc ann) -> Doc ann
    pageWidth \case
                AvailablePerLine Int
    n Double
    _ | Text -> Int
    Text.length Text
    str Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i ->
                    Text -> Doc DocClass
    prettyMlString Text
    str
                PageWidth
    _ -> Text -> Doc DocClass
    prettyString Text
    str
        | Bool
    otherwise = Text -> Doc DocClass
    prettyString Text
    str

    prettyMlString :: Text -> TomlDoc
    prettyMlString :: Text -> Doc DocClass
    prettyMlString Text
    str = DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    StringClass ((Int -> Doc DocClass) -> Doc DocClass
    forall ann. (Int -> Doc ann) -> Doc ann
    column \Int
    i -> Int -> Doc DocClass -> Doc DocClass
    forall ann. Int -> Doc ann -> Doc ann
    hang (-Int
    i) (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (String -> String
    quoteMlString (Text -> String
    Text.unpack Text
    str))))

    prettyString :: Text -> TomlDoc
    prettyString :: Text -> Doc DocClass
    prettyString Text
    str = DocClass -> Doc DocClass -> Doc DocClass
    forall ann. ann -> Doc ann -> Doc ann
    annotate DocClass
    StringClass (String -> Doc DocClass
    forall a. IsString a => String -> a
    fromString (String -> String
    quoteString (Text -> String
    Text.unpack Text
    str)))

    -- | Predicate for values that CAN rendered on the
    -- right-hand side of an @=@.
    isSimple :: Value' l -> Bool
    isSimple :: forall l. Value' l -> Bool
    isSimple = \case
        Integer'   {} -> Bool
    True
        Double'    {} -> Bool
    True
        Bool'      {} -> Bool
    True
        Text'      {} -> Bool
    True
        TimeOfDay' {} -> Bool
    True
        ZonedTime' {} -> Bool
    True
        LocalTime' {} -> Bool
    True
        Day'       {} -> Bool
    True
        Table' l
    _    Table' l
    x -> Table' l -> Bool
    forall l. Table' l -> Bool
    isSingularTable Table' l
    x -- differs from isAlwaysSimple
        List'  l
    _    [Value' l]
    x -> [Value' l] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Value' l]
    x Bool -> Bool -> Bool
    || Bool -> Bool
    not ((Value' l -> Bool) -> [Value' l] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Value' l -> Bool
    forall l. Value' l -> Bool
    isTable [Value' l]
    x)

    -- | Predicate for values that can be MUST rendered on the
    -- right-hand side of an @=@.
    isAlwaysSimple :: Value' l -> Bool
    isAlwaysSimple :: forall l. Value' l -> Bool
    isAlwaysSimple = \case
        Integer'   {} -> Bool
    True
        Double'    {} -> Bool
    True
        Bool'      {} -> Bool
    True
        Text'      {} -> Bool
    True
        TimeOfDay' {} -> Bool
    True
        ZonedTime' {} -> Bool
    True
        LocalTime' {} -> Bool
    True
        Day'       {} -> Bool
    True
        Table'     {} -> Bool
    False -- differs from isSimple
        List' l
    _     [Value' l]
    x -> [Value' l] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Value' l]
    x Bool -> Bool -> Bool
    || Bool -> Bool
    not ((Value' l -> Bool) -> [Value' l] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Value' l -> Bool
    forall l. Value' l -> Bool
    isTable [Value' l]
    x)

    -- | Predicate for table values.
    isTable :: Value' l -> Bool
    isTable :: forall l. Value' l -> Bool
    isTable Table'{} = Bool
    True
    isTable Value' l
    _        = Bool
    False

    -- | Predicate for tables that can be rendered with a single assignment.
    -- These can be collapsed using dotted-key notation on the left-hand side
    -- of a @=@.
    isSingularTable :: Table' l -> Bool
    isSingularTable :: forall l. Table' l -> Bool
    isSingularTable (MkTable (Map Text (l, Value' l) -> [(l, Value' l)]
    forall k a. Map k a -> [a]
    Map.elems -> [(l
    _, Value' l
    v)])) = Value' l -> Bool
    forall l. Value' l -> Bool
    isSimple Value' l
    v
    isSingularTable Table' l
    _ = 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' a {- ^ table to print -} ->
        TomlDoc {- ^ TOML syntax -}
    prettyToml :: forall a. Table' a -> Doc DocClass
    prettyToml = KeyProjection -> SectionKind -> [Text] -> Table' a -> Doc DocClass
    forall l.
    KeyProjection -> SectionKind -> [Text] -> Table' l -> 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 ancillary 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
    -- @
    prettyTomlOrdered ::
      Ord a =>
      ([Text] -> Text -> a) {- ^ table path -> key -> projection -} ->
      Table' l {- ^ table to print -} ->
      TomlDoc {- ^ TOML syntax -}
    prettyTomlOrdered :: forall a l.
    Ord a =>
    ([Text] -> Text -> a) -> Table' l -> Doc DocClass
    prettyTomlOrdered [Text] -> Text -> a
    proj = KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    forall l.
    KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    prettyToml_ (([Text] -> Text -> a) -> KeyProjection
    forall a. Ord a => ([Text] -> Text -> a) -> KeyProjection
    KeyProjection [Text] -> Text -> 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 => ([Text] -> Text -> a) -> KeyProjection

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

            kvs :: [(Text, (l, Value' l))]
    kvs = [(Text, (l, Value' l))] -> [(Text, (l, Value' l))]
    order (Map Text (l, Value' l) -> [(Text, (l, Value' l))]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map Text (l, Value' l)
    t)

            -- this table will require no subsequent tables to be defined
            simpleToml :: Bool
    simpleToml = ((l, Value' l) -> Bool) -> Map Text (l, Value' l) -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Value' l -> Bool
    forall l. Value' l -> Bool
    isSimple (Value' l -> Bool)
    -> ((l, Value' l) -> Value' l) -> (l, Value' l) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (l, Value' l) -> Value' l
    forall a b. (a, b) -> b
    snd) Map Text (l, Value' l)
    t

            ([(Text, (l, Value' l))]
    simple, [(Text, (l, Value' l))]
    sections) = ((Text, (l, Value' l)) -> Bool)
    -> [(Text, (l, Value' l))]
    -> ([(Text, (l, Value' l))], [(Text, (l, Value' l))])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Value' l -> Bool
    forall l. Value' l -> Bool
    isAlwaysSimple (Value' l -> Bool)
    -> ((Text, (l, Value' l)) -> Value' l)
    -> (Text, (l, Value' l))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (l, Value' l) -> Value' l
    forall a b. (a, b) -> b
    snd ((l, Value' l) -> Value' l)
    -> ((Text, (l, Value' l)) -> (l, Value' l))
    -> (Text, (l, Value' l))
    -> Value' l
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, (l, Value' l)) -> (l, Value' l)
    forall a b. (a, b) -> b
    snd) [(Text, (l, Value' l))]
    kvs

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

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

            assignments :: [Doc DocClass]
    assignments = [Text -> Value' l -> Doc DocClass
    forall l. Text -> Value' l -> Doc DocClass
    prettyAssignment Text
    k Value' l
    v Doc DocClass -> Doc DocClass -> Doc DocClass
    forall a. Semigroup a => a -> a -> a
    <> Doc DocClass
    forall ann. Doc ann
    hardline | (Text
    k,(l
    _, Value' l
    v)) <- if Bool
    simpleToml then [(Text, (l, Value' l))]
    kvs else [(Text, (l, Value' l))]
    simple]

            subtables :: [Doc DocClass]
    subtables = [[Text] -> Value' l -> Doc DocClass
    prettySection ([Text]
    prefix [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text
    k]) Value' l
    v | Bool -> Bool
    not Bool
    simpleToml, (Text
    k,(l
    _, Value' l
    v)) <- [(Text, (l, Value' l))]
    sections]

            prettySection :: [Text] -> Value' l -> Doc DocClass
    prettySection [Text]
    key (Table' l
    _ Table' l
    tab) =
                KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    forall l.
    KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    prettyToml_ KeyProjection
    mbKeyProj SectionKind
    TableKind [Text]
    key Table' l
    tab
            prettySection [Text]
    key (List' l
    _ [Value' l]
    a) =
                [Doc DocClass] -> Doc DocClass
    forall ann. [Doc ann] -> Doc ann
    vcat [KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    forall l.
    KeyProjection -> SectionKind -> [Text] -> Table' l -> Doc DocClass
    prettyToml_ KeyProjection
    mbKeyProj SectionKind
    ArrayTableKind [Text]
    key Table' l
    tab | Table' l
    _ Table' l
    tab <- [Value' l]
    a]
            prettySection [Text]
    _ Value' l
    _ = String -> Doc DocClass
    forall a. HasCallStack => String -> a
    error String
    "prettySection applied to simple value"

    -- | Pretty-print as @line:col: message@
    prettyLocated :: Located String -> String
    prettyLocated :: Located String -> String
    prettyLocated (Located Position
    p String
    s) = String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s: %s" (Position -> String
    prettyPosition Position
    p) String
    s

    -- | Pretty-print as @line:col@
    prettyPosition :: Position -> String
    prettyPosition :: Position -> String
    prettyPosition Position
    p = String -> Int -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    "%d:%d" (Position -> Int
    posLine Position
    p) (Position -> Int
    posColumn Position
    p)