module Bookhound.Format.Parsers.Toml (toml, nil, integer, float, bool, string,
                     array, inlineTable) where

import Bookhound.Parser              (Parser, withError)
import Bookhound.ParserCombinators   (IsMatch (..), maybeWithin, within, (<#>),
                                      (<|>), (>>>), (|*), (|+), (|?))
import Bookhound.Parsers.Char        (dash, digit, dot, doubleQuote, equal,
                                      hashTag, letter, newLine, quote,
                                      spaceOrTab, underscore, whiteSpace)
import Bookhound.Parsers.Collections (listOf, mapOf)
import Bookhound.Parsers.Number      (double, hexInt, int, octInt)
import Bookhound.Parsers.String      (blankLine, blankLines, spacesOrTabs,
                                      spacing, withinDoubleQuotes, withinQuotes,
                                      withinSquareBrackets)

import Bookhound.Format.SyntaxTrees.Toml    (TableType (..), TomlExpression (..))

import qualified Bookhound.Parsers.DateTime as Dt

import qualified Data.Map   as Map
import           Data.Maybe (maybeToList)



toml :: Parser TomlExpression
toml :: Parser TomlExpression
toml = Parser [[Char]] -> Parser TomlExpression -> Parser TomlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin (((Char -> [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char]) -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
whiteSpace) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char]
comment) Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
|+) Parser TomlExpression
topLevelTable



-- TODO: Add support for table arrays

nil :: Parser TomlExpression
nil :: Parser TomlExpression
nil = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Null"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ TomlExpression
TomlNull TomlExpression -> Parser [Char] -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"null"

integer :: Parser TomlExpression
integer :: Parser TomlExpression
integer = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Integer"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ Integer -> TomlExpression
TomlInteger (Integer -> TomlExpression)
-> Parser Integer -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Integer
hexInt Parser Integer -> Parser Integer -> Parser Integer
forall a. Parser a -> Parser a -> Parser a
<|> Parser Integer
octInt Parser Integer -> Parser Integer -> Parser Integer
forall a. Parser a -> Parser a -> Parser a
<|> Parser Integer
int)

float :: Parser TomlExpression
float :: Parser TomlExpression
float = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Float"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ Double -> TomlExpression
TomlFloat (Double -> TomlExpression)
-> Parser Double -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
double

bool :: Parser TomlExpression
bool :: Parser TomlExpression
bool = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Bool"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ Bool -> TomlExpression
TomlBool (Bool -> TomlExpression) -> Parser Bool -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
True  Bool -> Parser [Char] -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"true"  Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
<|>
                Bool
False Bool -> Parser [Char] -> Parser Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"false")


dateTime :: Parser TomlExpression
dateTime :: Parser TomlExpression
dateTime = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml DateTime"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ ZonedTime -> TomlExpression
TomlDateTime (ZonedTime -> TomlExpression)
-> Parser ZonedTime -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ZonedTime
Dt.dateTime

date :: Parser TomlExpression
date :: Parser TomlExpression
date = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Date"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ Day -> TomlExpression
TomlDate (Day -> TomlExpression) -> Parser Day -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
Dt.date

time :: Parser TomlExpression
time :: Parser TomlExpression
time = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Time"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> TomlExpression
TomlTime (TimeOfDay -> TomlExpression)
-> Parser TimeOfDay -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
Dt.time


string :: Parser TomlExpression
string :: Parser TomlExpression
string = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml String"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ [Char] -> TomlExpression
TomlString ([Char] -> TomlExpression)
-> Parser [Char] -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
text
  where
    text :: Parser [Char]
text = Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b. Parser a -> Parser b -> Parser b
within (Parser Char
doubleQuote Parser Char -> Integer -> Parser [Char]
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3) (Parser [Char] -> Parser [Char]
forall b. Monoid b => Parser b -> Parser b
multiline (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
           Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b. Parser a -> Parser b -> Parser b
within  (Parser Char
quote Parser Char -> Integer -> Parser [Char]
forall a. Parser a -> Integer -> Parser [a]
<#> Integer
3)      (Parser [Char] -> Parser [Char]
forall b. Monoid b => Parser b -> Parser b
multiline (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
quote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*))       Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
           Parser [Char] -> Parser [Char]
forall b. Parser b -> Parser b
withinDoubleQuotes         (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)             Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
           Parser [Char] -> Parser [Char]
forall b. Parser b -> Parser b
withinQuotes               (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
quote       Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)

    multiline :: Parser b -> Parser b
multiline Parser b
parser = [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> Parser [b] -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Parser [Char]
blankLine Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?) Parser (Maybe [Char]) -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser b -> Parser b
forall b. Parser b -> Parser b
line Parser b
parser) Parser b -> Parser [b]
forall a. Parser a -> Parser [a]
|*)

    line :: Parser b -> Parser b
line Parser b
parser = [Char] -> Parser [Char]
forall a. IsMatch a => a -> Parser a
is [Char]
"\\" Parser [Char] -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char
whiteSpace Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*) Parser [Char] -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser b
parser


array :: Parser TomlExpression
array :: Parser TomlExpression
array = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Array"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ [TomlExpression] -> TomlExpression
TomlArray ([TomlExpression] -> TomlExpression)
-> Parser [TomlExpression] -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TomlExpression -> Parser [TomlExpression]
forall a. Parser a -> Parser [a]
listOf (Parser [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacing Parser TomlExpression
tomlExpr)


key :: Parser String
key :: Parser [Char]
key = Parser [Char]
keyParser Parser [Char] -> Parser [[Char]] -> Parser [Char]
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser [Char]
>>> ((Parser Char
dot Parser Char -> Parser [Char] -> Parser [Char]
forall a b.
(ToString a, ToString b) =>
Parser a -> Parser b -> Parser [Char]
>>> Parser [Char]
keyParser) Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
|*)
  where
    keyParser :: Parser [Char]
keyParser = Parser [Char] -> Parser [Char] -> Parser [Char]
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$ Parser [Char]
freeText      Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
                Parser [Char] -> Parser [Char]
forall b. Parser b -> Parser b
withinDoubleQuotes (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|>
                Parser [Char] -> Parser [Char]
forall b. Parser b -> Parser b
withinQuotes (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
quote Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|*)

    freeText :: Parser [Char]
freeText = ((Parser Char
letter Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
<|> Parser Char
digit Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
<|> Parser Char
underscore Parser Char -> Parser Char -> Parser Char
forall a. Parser a -> Parser a -> Parser a
<|> Parser Char
dash) Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|+)


inlineTable :: Parser TomlExpression
inlineTable :: Parser TomlExpression
inlineTable = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Table"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ TableType -> Map [Char] TomlExpression -> TomlExpression
TomlTable TableType
Inline (Map [Char] TomlExpression -> TomlExpression)
-> Parser (Map [Char] TomlExpression) -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
-> Parser [Char]
-> Parser TomlExpression
-> Parser (Map [Char] TomlExpression)
forall b a c.
Ord b =>
Parser a -> Parser b -> Parser c -> Parser (Map b c)
mapOf Parser Char
equal Parser [Char]
key Parser TomlExpression
tomlExpr


topLevelTable :: Parser TomlExpression
topLevelTable :: Parser TomlExpression
topLevelTable = [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a. [Char] -> Parser a -> Parser a
withError [Char]
"Toml Table"
  (Parser TomlExpression -> Parser TomlExpression)
-> Parser TomlExpression -> Parser TomlExpression
forall a b. (a -> b) -> a -> b
$ TableType -> Map [Char] TomlExpression -> TomlExpression
TomlTable TableType
TopLevel (Map [Char] TomlExpression -> TomlExpression)
-> ([([Char], TomlExpression)] -> Map [Char] TomlExpression)
-> [([Char], TomlExpression)]
-> TomlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], TomlExpression)] -> Map [Char] TomlExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], TomlExpression)] -> TomlExpression)
-> Parser [([Char], TomlExpression)] -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char]
-> Parser [([Char], TomlExpression)]
-> Parser [([Char], TomlExpression)]
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacing Parser [([Char], TomlExpression)]
tables
  where
    tables :: Parser [([Char], TomlExpression)]
tables = do [([Char], TomlExpression)]
xs <- Parser [([Char], TomlExpression)]
keyValueSeqParser
                [([Char], TomlExpression)]
ys <- (Parser ([Char], TomlExpression)
tableParser Parser ([Char], TomlExpression)
-> Parser [([Char], TomlExpression)]
forall a. Parser a -> Parser [a]
|*)
                pure ([([Char], TomlExpression)]
ys [([Char], TomlExpression)]
-> [([Char], TomlExpression)] -> [([Char], TomlExpression)]
forall a. Semigroup a => a -> a -> a
<> [([Char]
"", TableType -> Map [Char] TomlExpression -> TomlExpression
TomlTable TableType
Standard (Map [Char] TomlExpression -> TomlExpression)
-> ([([Char], TomlExpression)] -> Map [Char] TomlExpression)
-> [([Char], TomlExpression)]
-> TomlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], TomlExpression)] -> Map [Char] TomlExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], TomlExpression)] -> TomlExpression)
-> [([Char], TomlExpression)] -> TomlExpression
forall a b. (a -> b) -> a -> b
$ [([Char], TomlExpression)]
xs)])

    tableParser :: Parser ([Char], TomlExpression)
tableParser = do [Char]
k <- Parser [Char] -> Parser [Char]
forall b. Parser b -> Parser b
withinSquareBrackets Parser [Char]
key
                     TomlExpression
v <- Parser [Char] -> Parser TomlExpression -> Parser TomlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacing Parser TomlExpression
standardTable
                     pure ([Char]
k, TomlExpression
v)

    standardTable :: Parser TomlExpression
standardTable = TableType -> Map [Char] TomlExpression -> TomlExpression
TomlTable TableType
Standard (Map [Char] TomlExpression -> TomlExpression)
-> ([([Char], TomlExpression)] -> Map [Char] TomlExpression)
-> [([Char], TomlExpression)]
-> TomlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], TomlExpression)] -> Map [Char] TomlExpression
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], TomlExpression)] -> TomlExpression)
-> Parser [([Char], TomlExpression)] -> Parser TomlExpression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [([Char], TomlExpression)]
keyValueSeqParser


    keyValueSeqParser :: Parser [([Char], TomlExpression)]
keyValueSeqParser = do [([Char], TomlExpression)]
xs <- ((Parser ([Char], TomlExpression)
keyValueParser Parser ([Char], TomlExpression)
-> Parser (Maybe [Char]) -> Parser ([Char], TomlExpression)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser [Char]
blankLine Parser [Char] -> Parser (Maybe [Char]) -> Parser (Maybe [Char])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser [Char]
blankLines Parser [Char] -> Parser (Maybe [Char])
forall a. Parser a -> Parser (Maybe a)
|?))) Parser ([Char], TomlExpression)
-> Parser [([Char], TomlExpression)]
forall a. Parser a -> Parser [a]
|*)
                           Maybe ([Char], TomlExpression)
x  <- (Parser ([Char], TomlExpression)
keyValueParser Parser ([Char], TomlExpression)
-> Parser (Maybe ([Char], TomlExpression))
forall a. Parser a -> Parser (Maybe a)
|?)
                           pure  ([([Char], TomlExpression)]
xs [([Char], TomlExpression)]
-> [([Char], TomlExpression)] -> [([Char], TomlExpression)]
forall a. Semigroup a => a -> a -> a
<> Maybe ([Char], TomlExpression) -> [([Char], TomlExpression)]
forall a. Maybe a -> [a]
maybeToList Maybe ([Char], TomlExpression)
x)

    keyValueParser :: Parser ([Char], TomlExpression)
keyValueParser = do [Char]
k <- Parser [Char]
key
                        Parser [Char] -> Parser Char -> Parser Char
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser [Char]
spacesOrTabs Parser Char
equal
                        TomlExpression
v <- Parser TomlExpression
tomlExpr
                        pure ([Char]
k, TomlExpression
v)



element :: Parser TomlExpression
element :: Parser TomlExpression
element = Parser TomlExpression
dateTime Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
date Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
time Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
float Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|>
          Parser TomlExpression
integer  Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
bool Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
nil  Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
string


container :: Parser TomlExpression
container :: Parser TomlExpression
container = Parser TomlExpression
array Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
inlineTable


comment :: Parser String
comment :: Parser [Char]
comment = Parser Char
hashTag Parser Char -> Parser [Char] -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
newLine Parser Char -> Parser [Char]
forall a. Parser a -> Parser [a]
|+) Parser [Char] -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char
newLine


tomlExpr :: Parser TomlExpression
tomlExpr :: Parser TomlExpression
tomlExpr = Parser [[Char]] -> Parser TomlExpression -> Parser TomlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin (((Char -> [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char]) -> Parser Char -> Parser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
spaceOrTab) Parser [Char] -> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [Char]
comment) Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
|+) Parser TomlExpression
tomlValue
  where
    tomlValue :: Parser TomlExpression
tomlValue = Parser TomlExpression
element Parser TomlExpression
-> Parser TomlExpression -> Parser TomlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser TomlExpression
container