{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Parse a TOML document.

References:

* https://toml.io/en/v1.0.0
* https://github.com/toml-lang/toml/blob/1.0.0/toml.abnf
-}
module TOML.Parser (
  parseTOML,
) where

import Control.Monad (guard, unless, void, when)
import Control.Monad.Combinators.NonEmpty (sepBy1)
import Data.Bifunctor (bimap)
import Data.Char (chr, isDigit, isSpace, ord)
import Data.Fixed (Fixed (..))
import Data.Foldable (foldl', foldlM)
import Data.Functor (($>))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (Day, LocalTime, TimeOfDay, TimeZone)
import qualified Data.Time as Time
import Data.Void (Void)
import qualified Numeric
import Text.Megaparsec hiding (sepBy1)
import Text.Megaparsec.Char hiding (space, space1)
import qualified Text.Megaparsec.Char.Lexer as L

import TOML.Error (NormalizeError (..), TOMLError (..))
import TOML.Utils.Map (getPathLens)
import TOML.Value (Table, Value (..))

parseTOML ::
  -- | Name of file (for error messages)
  String ->
  -- | Input
  Text ->
  Either TOMLError Value
parseTOML :: String -> Text -> Either TOMLError Value
parseTOML String
filename Text
input =
  case Parsec Void Text TOMLDoc
-> String -> Text -> Either (ParseErrorBundle Text Void) TOMLDoc
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text TOMLDoc
parseTOMLDocument String
filename Text
input of
    Left ParseErrorBundle Text Void
e -> TOMLError -> Either TOMLError Value
forall a b. a -> Either a b
Left (TOMLError -> Either TOMLError Value)
-> TOMLError -> Either TOMLError Value
forall a b. (a -> b) -> a -> b
$ Text -> TOMLError
ParseError (Text -> TOMLError) -> Text -> TOMLError
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
    Right TOMLDoc
result -> Table -> Value
Table (Table -> Value)
-> Either TOMLError Table -> Either TOMLError Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TOMLDoc -> Either TOMLError Table
normalize TOMLDoc
result

-- 'Value' generalized to allow for unnormalized + annotated Values.
data GenericValue map key tableMeta arrayMeta
  = GenericTable tableMeta (map key (GenericValue map key tableMeta arrayMeta))
  | GenericArray arrayMeta [GenericValue map key tableMeta arrayMeta]
  | GenericString Text
  | GenericInteger Integer
  | GenericFloat Double
  | GenericBoolean Bool
  | GenericOffsetDateTime (LocalTime, TimeZone)
  | GenericLocalDateTime LocalTime
  | GenericLocalDate Day
  | GenericLocalTime TimeOfDay

fromGenericValue ::
  (map key (GenericValue map key tableMeta arrayMeta) -> Table) ->
  GenericValue map key tableMeta arrayMeta ->
  Value
fromGenericValue :: (map key (GenericValue map key tableMeta arrayMeta) -> Table)
-> GenericValue map key tableMeta arrayMeta -> Value
fromGenericValue map key (GenericValue map key tableMeta arrayMeta) -> Table
fromGenericTable = \case
  GenericTable tableMeta
_ map key (GenericValue map key tableMeta arrayMeta)
t -> Table -> Value
Table (Table -> Value) -> Table -> Value
forall a b. (a -> b) -> a -> b
$ map key (GenericValue map key tableMeta arrayMeta) -> Table
fromGenericTable map key (GenericValue map key tableMeta arrayMeta)
t
  GenericArray arrayMeta
_ [GenericValue map key tableMeta arrayMeta]
vs -> [Value] -> Value
Array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (GenericValue map key tableMeta arrayMeta -> Value)
-> [GenericValue map key tableMeta arrayMeta] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((map key (GenericValue map key tableMeta arrayMeta) -> Table)
-> GenericValue map key tableMeta arrayMeta -> Value
forall (map :: * -> * -> *) key tableMeta arrayMeta.
(map key (GenericValue map key tableMeta arrayMeta) -> Table)
-> GenericValue map key tableMeta arrayMeta -> Value
fromGenericValue map key (GenericValue map key tableMeta arrayMeta) -> Table
fromGenericTable) [GenericValue map key tableMeta arrayMeta]
vs
  GenericString Text
x -> Text -> Value
String Text
x
  GenericInteger Integer
x -> Integer -> Value
Integer Integer
x
  GenericFloat Double
x -> Double -> Value
Float Double
x
  GenericBoolean Bool
x -> Bool -> Value
Boolean Bool
x
  GenericOffsetDateTime (LocalTime, TimeZone)
x -> (LocalTime, TimeZone) -> Value
OffsetDateTime (LocalTime, TimeZone)
x
  GenericLocalDateTime LocalTime
x -> LocalTime -> Value
LocalDateTime LocalTime
x
  GenericLocalDate Day
x -> Day -> Value
LocalDate Day
x
  GenericLocalTime TimeOfDay
x -> TimeOfDay -> Value
LocalTime TimeOfDay
x

{--- Parse raw document ---}

type Parser = Parsec Void Text

-- | An unannotated, unnormalized value.
type RawValue = GenericValue LookupMap Key () ()

type Key = NonEmpty Text
type RawTable = LookupMap Key RawValue
newtype LookupMap k v = LookupMap {LookupMap k v -> [(k, v)]
unLookupMap :: [(k, v)]}

data TOMLDoc = TOMLDoc
  { TOMLDoc -> RawTable
rootTable :: RawTable
  , TOMLDoc -> [TableSection]
subTables :: [TableSection]
  }

data TableSection = TableSection
  { TableSection -> TableSectionHeader
tableSectionHeader :: TableSectionHeader
  , TableSection -> RawTable
tableSectionTable :: RawTable
  }

data TableSectionHeader = SectionTable Key | SectionTableArray Key

parseTOMLDocument :: Parser TOMLDoc
parseTOMLDocument :: Parsec Void Text TOMLDoc
parseTOMLDocument = do
  Parser ()
emptyLines
  RawTable
rootTable <- Parser RawTable
parseRawTable
  Parser ()
emptyLines
  [TableSection]
subTables <- ParsecT Void Text Identity TableSection
-> ParsecT Void Text Identity [TableSection]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity TableSection
parseTableSection
  Parser ()
emptyLines
  Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  TOMLDoc -> Parsec Void Text TOMLDoc
forall (m :: * -> *) a. Monad m => a -> m a
return TOMLDoc :: RawTable -> [TableSection] -> TOMLDoc
TOMLDoc{[TableSection]
RawTable
subTables :: [TableSection]
rootTable :: RawTable
subTables :: [TableSection]
rootTable :: RawTable
..}

parseRawTable :: Parser RawTable
parseRawTable :: Parser RawTable
parseRawTable = ([(Key, RawValue)] -> RawTable)
-> ParsecT Void Text Identity [(Key, RawValue)] -> Parser RawTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Key, RawValue)] -> RawTable
forall k v. [(k, v)] -> LookupMap k v
LookupMap (ParsecT Void Text Identity [(Key, RawValue)] -> Parser RawTable)
-> ParsecT Void Text Identity [(Key, RawValue)] -> Parser RawTable
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Key, RawValue)
-> ParsecT Void Text Identity [(Key, RawValue)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity (Key, RawValue)
 -> ParsecT Void Text Identity [(Key, RawValue)])
-> ParsecT Void Text Identity (Key, RawValue)
-> ParsecT Void Text Identity [(Key, RawValue)]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Key, RawValue)
parseKeyValue ParsecT Void Text Identity (Key, RawValue)
-> Parser () -> ParsecT Void Text Identity (Key, RawValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endOfLine ParsecT Void Text Identity (Key, RawValue)
-> Parser () -> ParsecT Void Text Identity (Key, RawValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines

parseTableSection :: Parser TableSection
parseTableSection :: ParsecT Void Text Identity TableSection
parseTableSection = do
  TableSectionHeader
tableSectionHeader <-
    [ParsecT Void Text Identity TableSectionHeader]
-> ParsecT Void Text Identity TableSectionHeader
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Key -> TableSectionHeader
SectionTableArray (Key -> TableSectionHeader)
-> ParsecT Void Text Identity Key
-> ParsecT Void Text Identity TableSectionHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ParsecT Void Text Identity Key
parseHeader Text
"[[" Text
"]]"
      , Key -> TableSectionHeader
SectionTable (Key -> TableSectionHeader)
-> ParsecT Void Text Identity Key
-> ParsecT Void Text Identity TableSectionHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ParsecT Void Text Identity Key
parseHeader Text
"[" Text
"]"
      ]
  Parser ()
endOfLine
  Parser ()
emptyLines
  RawTable
tableSectionTable <- Parser RawTable
parseRawTable
  Parser ()
emptyLines
  TableSection -> ParsecT Void Text Identity TableSection
forall (m :: * -> *) a. Monad m => a -> m a
return TableSection :: TableSectionHeader -> RawTable -> TableSection
TableSection{TableSectionHeader
RawTable
tableSectionTable :: RawTable
tableSectionHeader :: TableSectionHeader
tableSectionTable :: RawTable
tableSectionHeader :: TableSectionHeader
..}
  where
    parseHeader :: Text -> Text -> ParsecT Void Text Identity Key
parseHeader Text
brackStart Text
brackEnd = Text -> Parser ()
hsymbol Text
brackStart Parser ()
-> ParsecT Void Text Identity Key -> ParsecT Void Text Identity Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Key
parseKey ParsecT Void Text Identity Key
-> Parser () -> ParsecT Void Text Identity Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser ()
hsymbol Text
brackEnd

parseKeyValue :: Parser (Key, RawValue)
parseKeyValue :: ParsecT Void Text Identity (Key, RawValue)
parseKeyValue = do
  Key
key <- ParsecT Void Text Identity Key
parseKey
  Text -> Parser ()
hsymbol Text
"="
  RawValue
value <- Parser RawValue
parseValue
  (Key, RawValue) -> ParsecT Void Text Identity (Key, RawValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
key, RawValue
value)

parseKey :: Parser Key
parseKey :: ParsecT Void Text Identity Key
parseKey =
  (ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Key
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
`sepBy1` Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
hsymbol Text
".")) (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Key)
-> ([ParsecT Void Text Identity Text]
    -> ParsecT Void Text Identity Text)
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text Identity Text]
 -> ParsecT Void Text Identity Key)
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Key
forall a b. (a -> b) -> a -> b
$
    [ ParsecT Void Text Identity Text
parseBasicString
    , ParsecT Void Text Identity Text
parseLiteralString
    , ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
parseUnquotedKey
    ]
  where
    parseUnquotedKey :: ParsecT Void Text Identity (Tokens Text)
parseUnquotedKey =
      Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
        (String -> Maybe String
forall a. a -> Maybe a
Just String
"[A-Za-z0-9_-]")
        (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A' .. Char
'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-_")

parseValue :: Parser RawValue
parseValue :: Parser RawValue
parseValue =
  [Parser RawValue] -> Parser RawValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ () -> RawTable -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable () (RawTable -> RawValue) -> Parser RawTable -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser RawTable -> Parser RawTable
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"table" Parser RawTable
parseInlineTable
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ () -> [RawValue] -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
arrayMeta
-> [GenericValue map key tableMeta arrayMeta]
-> GenericValue map key tableMeta arrayMeta
GenericArray () ([RawValue] -> RawValue)
-> ParsecT Void Text Identity [RawValue] -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity [RawValue]
-> ParsecT Void Text Identity [RawValue]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"array" ParsecT Void Text Identity [RawValue]
parseInlineArray
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ Text -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Text -> GenericValue map key tableMeta arrayMeta
GenericString (Text -> RawValue)
-> ParsecT Void Text Identity Text -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"string" ParsecT Void Text Identity Text
parseString
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ (LocalTime, TimeZone) -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
(LocalTime, TimeZone) -> GenericValue map key tableMeta arrayMeta
GenericOffsetDateTime ((LocalTime, TimeZone) -> RawValue)
-> ParsecT Void Text Identity (LocalTime, TimeZone)
-> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity (LocalTime, TimeZone)
-> ParsecT Void Text Identity (LocalTime, TimeZone)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"offset-datetime" ParsecT Void Text Identity (LocalTime, TimeZone)
parseOffsetDateTime
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
LocalTime -> GenericValue map key tableMeta arrayMeta
GenericLocalDateTime (LocalTime -> RawValue)
-> ParsecT Void Text Identity LocalTime -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity LocalTime
-> ParsecT Void Text Identity LocalTime
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"local-datetime" ParsecT Void Text Identity LocalTime
parseLocalDateTime
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ Day -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Day -> GenericValue map key tableMeta arrayMeta
GenericLocalDate (Day -> RawValue)
-> ParsecT Void Text Identity Day -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Day -> ParsecT Void Text Identity Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"local-date" ParsecT Void Text Identity Day
parseLocalDate
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
TimeOfDay -> GenericValue map key tableMeta arrayMeta
GenericLocalTime (TimeOfDay -> RawValue)
-> ParsecT Void Text Identity TimeOfDay -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity TimeOfDay
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"local-time" ParsecT Void Text Identity TimeOfDay
parseLocalTime
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ Double -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Double -> GenericValue map key tableMeta arrayMeta
GenericFloat (Double -> RawValue)
-> ParsecT Void Text Identity Double -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"float" ParsecT Void Text Identity Double
parseFloat
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ Integer -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Integer -> GenericValue map key tableMeta arrayMeta
GenericInteger (Integer -> RawValue)
-> ParsecT Void Text Identity Integer -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"integer" ParsecT Void Text Identity Integer
parseInteger
    , Parser RawValue -> Parser RawValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser RawValue -> Parser RawValue)
-> Parser RawValue -> Parser RawValue
forall a b. (a -> b) -> a -> b
$ Bool -> RawValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Bool -> GenericValue map key tableMeta arrayMeta
GenericBoolean (Bool -> RawValue)
-> ParsecT Void Text Identity Bool -> Parser RawValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"boolean" ParsecT Void Text Identity Bool
parseBoolean
    ]

parseInlineTable :: Parser RawTable
parseInlineTable :: Parser RawTable
parseInlineTable = do
  Text -> Parser ()
hsymbol Text
"{"
  [(Key, RawValue)]
kvs <- ParsecT Void Text Identity (Key, RawValue)
parseKeyValue ParsecT Void Text Identity (Key, RawValue)
-> Parser () -> ParsecT Void Text Identity [(Key, RawValue)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser ()
hsymbol Text
",")
  Text -> Parser ()
hsymbol Text
"}"
  RawTable -> Parser RawTable
forall (m :: * -> *) a. Monad m => a -> m a
return (RawTable -> Parser RawTable) -> RawTable -> Parser RawTable
forall a b. (a -> b) -> a -> b
$ [(Key, RawValue)] -> RawTable
forall k v. [(k, v)] -> LookupMap k v
LookupMap [(Key, RawValue)]
kvs

parseInlineArray :: Parser [RawValue]
parseInlineArray :: ParsecT Void Text Identity [RawValue]
parseInlineArray = do
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[' ParsecT Void Text Identity Char
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines
  [RawValue]
vs <- (Parser RawValue
parseValue Parser RawValue -> Parser () -> Parser RawValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines) Parser RawValue
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [RawValue]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
',' ParsecT Void Text Identity Char
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
emptyLines)
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']'
  [RawValue] -> ParsecT Void Text Identity [RawValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [RawValue]
vs

parseString :: Parser Text
parseString :: ParsecT Void Text Identity Text
parseString =
  [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
parseMultilineBasicString
    , ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
parseMultilineLiteralString
    , ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
parseBasicString
    , ParsecT Void Text Identity Text
parseLiteralString
    ]

-- | A string in double quotes.
parseBasicString :: Parser Text
parseBasicString :: ParsecT Void Text Identity Text
parseBasicString =
  String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"double-quoted string" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
      (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity Text)
-> ([ParsecT Void Text Identity Char]
    -> ParsecT Void Text Identity String)
-> [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ([ParsecT Void Text Identity Char]
    -> ParsecT Void Text Identity Char)
-> [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text Identity Char]
 -> ParsecT Void Text Identity Text)
-> [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
        [ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isBasicChar
        , ParsecT Void Text Identity Char
parseEscaped
        ]

-- | A string in single quotes.
parseLiteralString :: Parser Text
parseLiteralString :: ParsecT Void Text Identity Text
parseLiteralString =
  String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"single-quoted string" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'') (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
      Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"literal-char") Char -> Bool
Token Text -> Bool
isLiteralChar

-- | A multiline string with three double quotes.
parseMultilineBasicString :: Parser Text
parseMultilineBasicString :: ParsecT Void Text Identity Text
parseMultilineBasicString =
  String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"double-quoted multiline string" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"\"\"" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
    Parser ()
lineContinuation
    [Text] -> Text
Text.concat ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (ParsecT Void Text Identity Text
mlBasicContent ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
lineContinuation) (Int -> Char -> ParsecT Void Text Identity Text
exactly Int
3 Char
'"')
  where
    mlBasicContent :: ParsecT Void Text Identity Text
mlBasicContent =
      [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Char
parseEscaped
        , Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isBasicChar
        , Char -> ParsecT Void Text Identity Text
parseMultilineDelimiter Char
'"'
        , ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
        ]
    lineContinuation :: Parser ()
lineContinuation = Parser () -> ParsecT Void Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void Text Identity Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
space) ParsecT Void Text Identity [()] -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A multiline string with three single quotes.
parseMultilineLiteralString :: Parser Text
parseMultilineLiteralString :: ParsecT Void Text Identity Text
parseMultilineLiteralString =
  String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"single-quoted multiline string" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"'''" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
    [Text] -> Text
Text.concat ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void Text Identity Text
mlLiteralContent (Int -> Char -> ParsecT Void Text Identity Text
exactly Int
3 Char
'\'')
  where
    mlLiteralContent :: ParsecT Void Text Identity Text
mlLiteralContent =
      [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isLiteralChar
        , Char -> ParsecT Void Text Identity Text
parseMultilineDelimiter Char
'\''
        , ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
        ]

parseEscaped :: Parser Char
parseEscaped :: ParsecT Void Text Identity Char
parseEscaped = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
parseEscapedChar
  where
    parseEscapedChar :: ParsecT Void Text Identity Char
parseEscapedChar =
      [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'b' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\b'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'f' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\f'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'n' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'r' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
't' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t'
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'u' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT Void Text Identity Char
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Char
unicodeHex Int
4
        , Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'U' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT Void Text Identity Char
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Char
unicodeHex Int
8
        ]

    unicodeHex :: Int -> m Char
unicodeHex Int
n = do
      Int
code <- Text -> Int
forall a. (Show a, Num a, Eq a) => Text -> a
readHex (Text -> Int) -> (String -> Text) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Int) -> m String -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Char -> m String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isUnicodeScalar Int
code
      Char -> m Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> m Char) -> Char -> m Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
code

{- |
Parse the multiline delimiter (" in """ quotes, or ' in ''' quotes), unless
the delimiter indicates the end of the multiline string.

i.e. parse 1 or 2 delimiters, or 4 or 5, which is 1 or 2 delimiters at the
end of a multiline string (then backtrack 3 to mark the end).
-}
parseMultilineDelimiter :: Char -> Parser Text
parseMultilineDelimiter :: Char -> ParsecT Void Text Identity Text
parseMultilineDelimiter Char
delim =
  [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Int -> Char -> ParsecT Void Text Identity Text
exactly Int
1 Char
delim
    , Int -> Char -> ParsecT Void Text Identity Text
exactly Int
2 Char
delim
    , do
        Text
_ <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Int -> Char -> ParsecT Void Text Identity Text
exactly Int
4 Char
delim)
        String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
1 (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
delim)
    , do
        Text
_ <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Int -> Char -> ParsecT Void Text Identity Text
exactly Int
5 Char
delim)
        String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
2 (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
delim)
    ]

isBasicChar :: Char -> Bool
isBasicChar :: Char -> Bool
isBasicChar Char
c =
  case Char
c of
    Char
' ' -> Bool
True
    Char
'\t' -> Bool
True
    Char
_ | Int
0x21 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7E -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\'
    Char
_ | Char -> Bool
isNonAscii Char
c -> Bool
True
    Char
_ -> Bool
False
  where
    code :: Int
code = Char -> Int
ord Char
c

isLiteralChar :: Char -> Bool
isLiteralChar :: Char -> Bool
isLiteralChar Char
c =
  case Char
c of
    Char
' ' -> Bool
True
    Char
'\t' -> Bool
True
    Char
_ | Int
0x21 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7E -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''
    Char
_ | Char -> Bool
isNonAscii Char
c -> Bool
True
    Char
_ -> Bool
False
  where
    code :: Int
code = Char -> Int
ord Char
c

parseOffsetDateTime :: Parser (LocalTime, TimeZone)
parseOffsetDateTime :: ParsecT Void Text Identity (LocalTime, TimeZone)
parseOffsetDateTime = (,) (LocalTime -> TimeZone -> (LocalTime, TimeZone))
-> ParsecT Void Text Identity LocalTime
-> ParsecT Void Text Identity (TimeZone -> (LocalTime, TimeZone))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity LocalTime
parseLocalDateTime ParsecT Void Text Identity (TimeZone -> (LocalTime, TimeZone))
-> ParsecT Void Text Identity TimeZone
-> ParsecT Void Text Identity (LocalTime, TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity TimeZone
parseTimezone
  where
    parseTimezone :: ParsecT Void Text Identity TimeZone
parseTimezone =
      [ParsecT Void Text Identity TimeZone]
-> ParsecT Void Text Identity TimeZone
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
Token Text
'Z' ParsecT Void Text Identity Char
-> TimeZone -> ParsecT Void Text Identity TimeZone
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TimeZone
Time.utc
        , do
            Int -> Int
applySign <- Parser (Int -> Int)
forall a. Num a => Parser (a -> a)
parseSign
            Int
h <- Parser Int
parseHours
            Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
            Int
m <- Parser Int
parseMinutes
            TimeZone -> ParsecT Void Text Identity TimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> ParsecT Void Text Identity TimeZone)
-> TimeZone -> ParsecT Void Text Identity TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> TimeZone
Time.minutesToTimeZone (Int -> TimeZone) -> Int -> TimeZone
forall a b. (a -> b) -> a -> b
$ Int -> Int
applySign (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m
        ]

parseLocalDateTime :: Parser LocalTime
parseLocalDateTime :: ParsecT Void Text Identity LocalTime
parseLocalDateTime = do
  Day
d <- ParsecT Void Text Identity Day
parseLocalDate
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
Token Text
'T' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '
  TimeOfDay
t <- ParsecT Void Text Identity TimeOfDay
parseLocalTime
  LocalTime -> ParsecT Void Text Identity LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> ParsecT Void Text Identity LocalTime)
-> LocalTime -> ParsecT Void Text Identity LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
Time.LocalTime Day
d TimeOfDay
t

parseLocalDate :: Parser Day
parseLocalDate :: ParsecT Void Text Identity Day
parseLocalDate = do
  Integer
y <- Int -> ParsecT Void Text Identity Integer
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
4
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'
  Int
m <- Int -> Parser Int
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
2
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'
  Int
d <- Int -> Parser Int
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
2
  ParsecT Void Text Identity Day
-> (Day -> ParsecT Void Text Identity Day)
-> Maybe Day
-> ParsecT Void Text Identity Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParsecT Void Text Identity Day
forall (f :: * -> *) a. Alternative f => f a
empty Day -> ParsecT Void Text Identity Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> ParsecT Void Text Identity Day)
-> Maybe Day -> ParsecT Void Text Identity Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid Integer
y Int
m Int
d

parseLocalTime :: Parser TimeOfDay
parseLocalTime :: ParsecT Void Text Identity TimeOfDay
parseLocalTime = do
  Int
h <- Parser Int
parseHours
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  Int
m <- Parser Int
parseMinutes
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  Int
sInt <- Parser Int
parseSeconds
  Maybe Text
sFracRaw <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  let sFrac :: Fixed E12
sFrac = Integer -> Fixed E12
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed E12) -> Integer -> Fixed E12
forall a b. (a -> b) -> a -> b
$ Integer -> (Text -> Integer) -> Maybe Text -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Text -> Integer
forall a. (Show a, Num a, Eq a) => Text -> a
readPicoDigits Maybe Text
sFracRaw
  TimeOfDay -> ParsecT Void Text Identity TimeOfDay
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay -> ParsecT Void Text Identity TimeOfDay)
-> TimeOfDay -> ParsecT Void Text Identity TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Fixed E12 -> TimeOfDay
Time.TimeOfDay Int
h Int
m (Int -> Fixed E12
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sInt Fixed E12 -> Fixed E12 -> Fixed E12
forall a. Num a => a -> a -> a
+ Fixed E12
sFrac)
  where
    readPicoDigits :: Text -> a
readPicoDigits Text
s = Text -> a
forall a. (Show a, Num a, Eq a) => Text -> a
readDec (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.take Int
12 (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
12 Text
"0")

parseHours :: Parser Int
parseHours :: Parser Int
parseHours = do
  Int
h <- Int -> Parser Int
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
2
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24
  Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
h

parseMinutes :: Parser Int
parseMinutes :: Parser Int
parseMinutes = do
  Int
m <- Int -> Parser Int
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
2
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60
  Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
m

parseSeconds :: Parser Int
parseSeconds :: Parser Int
parseSeconds = do
  Int
s <- Int -> Parser Int
forall a. (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits Int
2
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
60 -- include 60 for leap seconds
  Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s

parseFloat :: Parser Double
parseFloat :: ParsecT Void Text Identity Double
parseFloat = do
  Double -> Double
applySign <- Parser (Double -> Double)
forall a. Num a => Parser (a -> a)
parseSign
  Double
num <-
    [ParsecT Void Text Identity Double]
-> ParsecT Void Text Identity Double
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Double
normalFloat
      , ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Double
 -> ParsecT Void Text Identity Double)
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"inf" ParsecT Void Text Identity Text
-> Double -> ParsecT Void Text Identity Double
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Double
inf
      , ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Double
 -> ParsecT Void Text Identity Double)
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"nan" ParsecT Void Text Identity Text
-> Double -> ParsecT Void Text Identity Double
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Double
nan
      ]
  Double -> ParsecT Void Text Identity Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> ParsecT Void Text Identity Double)
-> Double -> ParsecT Void Text Identity Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
applySign Double
num
  where
    normalFloat :: ParsecT Void Text Identity Double
normalFloat = do
      Text
intPart <- ParsecT Void Text Identity Text
parseDecIntRaw
      (Text
fracPart, Text
expPart) <-
        [ParsecT Void Text Identity (Text, Text)]
-> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Text, Text)
 -> ParsecT Void Text Identity (Text, Text))
-> ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall a b. (a -> b) -> a -> b
$ (,) (Text -> Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"" ParsecT Void Text Identity (Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
parseExp
          , (,) (Text -> Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
parseFrac ParsecT Void Text Identity (Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. a -> Parser a -> Parser a
optionalOr Text
"" ParsecT Void Text Identity Text
parseExp
          ]
      Double -> ParsecT Void Text Identity Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> ParsecT Void Text Identity Double)
-> Double -> ParsecT Void Text Identity Double
forall a b. (a -> b) -> a -> b
$ Text -> Double
forall a. (Show a, RealFrac a) => Text -> a
readFloat (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ Text
intPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fracPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expPart

    parseExp :: ParsecT Void Text Identity Text
parseExp =
      ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat (ParsecT Void Text Identity [Text]
 -> ParsecT Void Text Identity Text)
-> ([ParsecT Void Text Identity Text]
    -> ParsecT Void Text Identity [Text])
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ParsecT Void Text Identity Text]
 -> ParsecT Void Text Identity Text)
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
        [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"e"
        , ParsecT Void Text Identity Text
parseSignRaw
        , ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
parseNumRaw ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
        ]
    parseFrac :: ParsecT Void Text Identity Text
parseFrac =
      ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat (ParsecT Void Text Identity [Text]
 -> ParsecT Void Text Identity Text)
-> ([ParsecT Void Text Identity Text]
    -> ParsecT Void Text Identity [Text])
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([ParsecT Void Text Identity Text]
 -> ParsecT Void Text Identity Text)
-> [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$
        [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"."
        , ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
parseNumRaw ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
        ]

    inf :: Double
inf = String -> Double
forall a. Read a => String -> a
read String
"Infinity"
    nan :: Double
nan = String -> Double
forall a. Read a => String -> a
read String
"NaN"

parseInteger :: Parser Integer
parseInteger :: ParsecT Void Text Identity Integer
parseInteger =
  [ParsecT Void Text Identity Integer]
-> ParsecT Void Text Identity Integer
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Integer
parseBinInt
    , ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Integer
parseOctInt
    , ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Integer
parseHexInt
    , ParsecT Void Text Identity Integer
parseSignedDecInt
    ]
  where
    parseSignedDecInt :: ParsecT Void Text Identity Integer
parseSignedDecInt = do
      Integer -> Integer
applySign <- Parser (Integer -> Integer)
forall a. Num a => Parser (a -> a)
parseSign
      Integer
num <- Text -> Integer
forall a. (Show a, Num a, Eq a) => Text -> a
readDec (Text -> Integer)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
parseDecIntRaw
      Integer -> ParsecT Void Text Identity Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> ParsecT Void Text Identity Integer)
-> Integer -> ParsecT Void Text Identity Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
applySign Integer
num
    parseHexInt :: ParsecT Void Text Identity Integer
parseHexInt =
      (Text -> Integer)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Integer
forall b.
(Text -> b)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity b
parsePrefixedInt Text -> Integer
forall a. (Show a, Num a, Eq a) => Text -> a
readHex Text
"0x" ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
    parseOctInt :: ParsecT Void Text Identity Integer
parseOctInt =
      (Text -> Integer)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Integer
forall b.
(Text -> b)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity b
parsePrefixedInt Text -> Integer
forall a. (Show a, Num a, Eq a) => Text -> a
readOct Text
"0o" ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar
    parseBinInt :: ParsecT Void Text Identity Integer
parseBinInt =
      (Text -> Integer)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Integer
forall b.
(Text -> b)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity b
parsePrefixedInt Text -> Integer
forall a. (Show a, Num a) => Text -> a
readBin Text
"0b" ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
binDigitChar

    parsePrefixedInt :: (Text -> b)
-> Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity b
parsePrefixedInt Text -> b
readInt Text
prefix ParsecT Void Text Identity Char
parseDigit = do
      Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
prefix
      Text -> b
readInt (Text -> b)
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
parseNumRaw ParsecT Void Text Identity Char
parseDigit ParsecT Void Text Identity Char
parseDigit

parseBoolean :: Parser Bool
parseBoolean :: ParsecT Void Text Identity Bool
parseBoolean =
  [ParsecT Void Text Identity Bool]
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Bool
True Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"true"
    , Bool
False Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"false"
    ]

{--- Normalize into Value ---}

-- | An annotated, normalized Value
type AnnValue = GenericValue Map Text TableMeta ArrayMeta

type AnnTable = Map Text AnnValue

unannotateTable :: AnnTable -> Table
unannotateTable :: AnnTable -> Table
unannotateTable = (AnnValue -> Value) -> AnnTable -> Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnnValue -> Value
unannotateValue

unannotateValue :: AnnValue -> Value
unannotateValue :: AnnValue -> Value
unannotateValue = (AnnTable -> Table) -> AnnValue -> Value
forall (map :: * -> * -> *) key tableMeta arrayMeta.
(map key (GenericValue map key tableMeta arrayMeta) -> Table)
-> GenericValue map key tableMeta arrayMeta -> Value
fromGenericValue AnnTable -> Table
unannotateTable

data TableType
  = -- | An inline table, e.g. "a.b" in:
    --
    -- @
    -- a.b = { c = 1 }
    -- @
    InlineTable
  | -- | A table created implicitly from a nested key, e.g. "a" in:
    --
    -- @
    -- a.b = 1
    -- @
    ImplicitKey
  | -- | An explicitly named section, e.g. "a.b.c" and "a.b" but not "a" in:
    --
    -- @
    -- [a.b.c]
    -- [a.b]
    -- @
    ExplicitSection
  | -- | An implicitly created section, e.g. "a" in:
    --
    -- @
    -- [a.b]
    -- @
    --
    -- Can later be converted into an explicit section
    ImplicitSection
  deriving (TableType -> TableType -> Bool
(TableType -> TableType -> Bool)
-> (TableType -> TableType -> Bool) -> Eq TableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableType -> TableType -> Bool
$c/= :: TableType -> TableType -> Bool
== :: TableType -> TableType -> Bool
$c== :: TableType -> TableType -> Bool
Eq)

data TableMeta = TableMeta
  { TableMeta -> TableType
tableType :: TableType
  }

data ArrayMeta = ArrayMeta
  { ArrayMeta -> Bool
isStaticArray :: Bool
  }

newtype NormalizeM a = NormalizeM
  { NormalizeM a -> Either NormalizeError a
runNormalizeM :: Either NormalizeError a
  }

instance Functor NormalizeM where
  fmap :: (a -> b) -> NormalizeM a -> NormalizeM b
fmap a -> b
f = Either NormalizeError b -> NormalizeM b
forall a. Either NormalizeError a -> NormalizeM a
NormalizeM (Either NormalizeError b -> NormalizeM b)
-> (NormalizeM a -> Either NormalizeError b)
-> NormalizeM a
-> NormalizeM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Either NormalizeError a -> Either NormalizeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either NormalizeError a -> Either NormalizeError b)
-> (NormalizeM a -> Either NormalizeError a)
-> NormalizeM a
-> Either NormalizeError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizeM a -> Either NormalizeError a
forall a. NormalizeM a -> Either NormalizeError a
runNormalizeM
instance Applicative NormalizeM where
  pure :: a -> NormalizeM a
pure = Either NormalizeError a -> NormalizeM a
forall a. Either NormalizeError a -> NormalizeM a
NormalizeM (Either NormalizeError a -> NormalizeM a)
-> (a -> Either NormalizeError a) -> a -> NormalizeM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either NormalizeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  NormalizeM Either NormalizeError (a -> b)
f <*> :: NormalizeM (a -> b) -> NormalizeM a -> NormalizeM b
<*> NormalizeM Either NormalizeError a
x = Either NormalizeError b -> NormalizeM b
forall a. Either NormalizeError a -> NormalizeM a
NormalizeM (Either NormalizeError (a -> b)
f Either NormalizeError (a -> b)
-> Either NormalizeError a -> Either NormalizeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either NormalizeError a
x)
instance Monad NormalizeM where
  NormalizeM a
m >>= :: NormalizeM a -> (a -> NormalizeM b) -> NormalizeM b
>>= a -> NormalizeM b
f = Either NormalizeError b -> NormalizeM b
forall a. Either NormalizeError a -> NormalizeM a
NormalizeM (Either NormalizeError b -> NormalizeM b)
-> Either NormalizeError b -> NormalizeM b
forall a b. (a -> b) -> a -> b
$ NormalizeM b -> Either NormalizeError b
forall a. NormalizeM a -> Either NormalizeError a
runNormalizeM (NormalizeM b -> Either NormalizeError b)
-> (a -> NormalizeM b) -> a -> Either NormalizeError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NormalizeM b
f (a -> Either NormalizeError b)
-> Either NormalizeError a -> Either NormalizeError b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NormalizeM a -> Either NormalizeError a
forall a. NormalizeM a -> Either NormalizeError a
runNormalizeM NormalizeM a
m

normalizeError :: NormalizeError -> NormalizeM a
normalizeError :: NormalizeError -> NormalizeM a
normalizeError = Either NormalizeError a -> NormalizeM a
forall a. Either NormalizeError a -> NormalizeM a
NormalizeM (Either NormalizeError a -> NormalizeM a)
-> (NormalizeError -> Either NormalizeError a)
-> NormalizeError
-> NormalizeM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizeError -> Either NormalizeError a
forall a b. a -> Either a b
Left

normalize :: TOMLDoc -> Either TOMLError Table
normalize :: TOMLDoc -> Either TOMLError Table
normalize = (NormalizeError -> TOMLError)
-> (AnnTable -> Table)
-> Either NormalizeError AnnTable
-> Either TOMLError Table
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap NormalizeError -> TOMLError
NormalizeError AnnTable -> Table
unannotateTable (Either NormalizeError AnnTable -> Either TOMLError Table)
-> (TOMLDoc -> Either NormalizeError AnnTable)
-> TOMLDoc
-> Either TOMLError Table
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizeM AnnTable -> Either NormalizeError AnnTable
forall a. NormalizeM a -> Either NormalizeError a
runNormalizeM (NormalizeM AnnTable -> Either NormalizeError AnnTable)
-> (TOMLDoc -> NormalizeM AnnTable)
-> TOMLDoc
-> Either NormalizeError AnnTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOMLDoc -> NormalizeM AnnTable
normalize'

normalize' :: TOMLDoc -> NormalizeM AnnTable
normalize' :: TOMLDoc -> NormalizeM AnnTable
normalize' TOMLDoc{[TableSection]
RawTable
subTables :: [TableSection]
rootTable :: RawTable
subTables :: TOMLDoc -> [TableSection]
rootTable :: TOMLDoc -> RawTable
..} = do
  AnnTable
root <- RawTable -> NormalizeM AnnTable
flattenTable RawTable
rootTable
  (AnnTable -> TableSection -> NormalizeM AnnTable)
-> AnnTable -> [TableSection] -> NormalizeM AnnTable
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM AnnTable -> TableSection -> NormalizeM AnnTable
mergeTableSection AnnTable
root [TableSection]
subTables
  where
    mergeTableSection :: AnnTable -> TableSection -> NormalizeM AnnTable
    mergeTableSection :: AnnTable -> TableSection -> NormalizeM AnnTable
mergeTableSection AnnTable
baseTable TableSection{TableSectionHeader
RawTable
tableSectionTable :: RawTable
tableSectionHeader :: TableSectionHeader
tableSectionTable :: TableSection -> RawTable
tableSectionHeader :: TableSection -> TableSectionHeader
..} = do
      case TableSectionHeader
tableSectionHeader of
        SectionTable Key
key ->
          Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionTable Key
key RawTable
tableSectionTable AnnTable
baseTable
        SectionTableArray Key
key ->
          Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionArray Key
key RawTable
tableSectionTable AnnTable
baseTable

mergeTableSectionTable :: Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionTable :: Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionTable Key
sectionKey RawTable
table AnnTable
baseTable =
  ValueAtPathOptions
-> Key
-> AnnTable
-> (Maybe AnnValue -> NormalizeM AnnValue)
-> NormalizeM AnnTable
setValueAtPath ValueAtPathOptions
valueAtPathOptions Key
sectionKey AnnTable
baseTable ((Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable)
-> (Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable
forall a b. (a -> b) -> a -> b
$ \Maybe AnnValue
mVal -> do
    AnnTable
tableToExtend <-
      case Maybe AnnValue
mVal of
        -- if a value doesn't already exist, initialize an empty Map
        Maybe AnnValue
Nothing -> AnnTable -> NormalizeM AnnTable
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnTable
forall k a. Map k a
Map.empty
        -- if a Table already exists at the path ...
        Just existingValue :: AnnValue
existingValue@(GenericTable TableMeta
meta AnnTable
existingTable) ->
          case TableMeta -> TableType
tableType TableMeta
meta of
            -- ... and is an inline table, error
            TableType
InlineTable -> AnnValue -> NormalizeM AnnTable
duplicateKeyError AnnValue
existingValue
            -- ... and was created as a nested key elsewhere, error
            TableType
ImplicitKey -> NormalizeM AnnTable
extendTableError
            -- ... and was created as a Table section explicitly defined elsewhere, error
            TableType
ExplicitSection -> NormalizeM AnnTable
duplicateSectionError
            -- ... otherwise, return the existing table
            TableType
_ -> AnnTable -> NormalizeM AnnTable
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnnTable
existingTable
        -- if some other Value already exists at the path, error
        Just AnnValue
existingValue -> AnnValue -> NormalizeM AnnTable
duplicateKeyError AnnValue
existingValue

    AnnTable
mergedTable <-
      MergeOptions -> AnnTable -> RawTable -> NormalizeM AnnTable
mergeRawTable
        MergeOptions :: Bool -> MergeOptions
MergeOptions{recurseImplicitSections :: Bool
recurseImplicitSections = Bool
False}
        AnnTable
tableToExtend
        RawTable
table

    let newTableMeta :: TableMeta
newTableMeta = TableMeta :: TableType -> TableMeta
TableMeta{tableType :: TableType
tableType = TableType
ExplicitSection}
    AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnValue -> NormalizeM AnnValue)
-> AnnValue -> NormalizeM AnnValue
forall a b. (a -> b) -> a -> b
$ TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
newTableMeta AnnTable
mergedTable
  where
    valueAtPathOptions :: ValueAtPathOptions
valueAtPathOptions =
      ValueAtPathOptions :: (TableType -> Bool)
-> TableType
-> (Key -> AnnValue -> NormalizeError)
-> ValueAtPathOptions
ValueAtPathOptions
        { shouldRecurse :: TableType -> Bool
shouldRecurse = \case
            TableType
InlineTable -> Bool
False
            TableType
ImplicitKey -> Bool
False
            TableType
ExplicitSection -> Bool
True
            TableType
ImplicitSection -> Bool
True
        , implicitType :: TableType
implicitType = TableType
ImplicitSection
        , makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError
makeMidPathNotTableError = Key -> RawTable -> Key -> AnnValue -> NormalizeError
nonTableInNestedKeyError Key
sectionKey RawTable
table
        }
    duplicateKeyError :: AnnValue -> NormalizeM AnnTable
duplicateKeyError AnnValue
existingValue =
      NormalizeError -> NormalizeM AnnTable
forall a. NormalizeError -> NormalizeM a
normalizeError
        DuplicateKeyError :: Key -> Value -> Value -> NormalizeError
DuplicateKeyError
          { _path :: Key
_path = Key
sectionKey
          , _existingValue :: Value
_existingValue = AnnValue -> Value
unannotateValue AnnValue
existingValue
          , _valueToSet :: Value
_valueToSet = Table -> Value
Table (Table -> Value) -> Table -> Value
forall a b. (a -> b) -> a -> b
$ RawTable -> Table
rawTableToApproxTable RawTable
table
          }
    extendTableError :: NormalizeM AnnTable
extendTableError =
      NormalizeError -> NormalizeM AnnTable
forall a. NormalizeError -> NormalizeM a
normalizeError
        ExtendTableError :: Key -> Key -> NormalizeError
ExtendTableError
          { _path :: Key
_path = Key
sectionKey
          , _originalKey :: Key
_originalKey = Key
sectionKey
          }
    duplicateSectionError :: NormalizeM AnnTable
duplicateSectionError =
      NormalizeError -> NormalizeM AnnTable
forall a. NormalizeError -> NormalizeM a
normalizeError
        DuplicateSectionError :: Key -> NormalizeError
DuplicateSectionError
          { _sectionKey :: Key
_sectionKey = Key
sectionKey
          }

mergeTableSectionArray :: Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionArray :: Key -> RawTable -> AnnTable -> NormalizeM AnnTable
mergeTableSectionArray Key
sectionKey RawTable
table AnnTable
baseTable = do
  ValueAtPathOptions
-> Key
-> AnnTable
-> (Maybe AnnValue -> NormalizeM AnnValue)
-> NormalizeM AnnTable
setValueAtPath ValueAtPathOptions
valueAtPathOptions Key
sectionKey AnnTable
baseTable ((Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable)
-> (Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable
forall a b. (a -> b) -> a -> b
$ \Maybe AnnValue
mVal -> do
    (ArrayMeta
meta, [AnnValue]
currArray) <-
      case Maybe AnnValue
mVal of
        -- if nothing exists, initialize an empty array
        Maybe AnnValue
Nothing -> do
          let meta :: ArrayMeta
meta = ArrayMeta :: Bool -> ArrayMeta
ArrayMeta{isStaticArray :: Bool
isStaticArray = Bool
False}
          (ArrayMeta, [AnnValue]) -> NormalizeM (ArrayMeta, [AnnValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayMeta
meta, [])
        -- if an array exists, insert table to the end of the array
        Just (GenericArray ArrayMeta
meta [AnnValue]
existingArray)
          | Bool -> Bool
not (ArrayMeta -> Bool
isStaticArray ArrayMeta
meta) ->
              (ArrayMeta, [AnnValue]) -> NormalizeM (ArrayMeta, [AnnValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayMeta
meta, [AnnValue]
existingArray)
        -- otherwise, error
        Just AnnValue
existingValue ->
          NormalizeError -> NormalizeM (ArrayMeta, [AnnValue])
forall a. NormalizeError -> NormalizeM a
normalizeError
            ImplicitArrayForDefinedKeyError :: Key -> Value -> Table -> NormalizeError
ImplicitArrayForDefinedKeyError
              { _path :: Key
_path = Key
sectionKey
              , _existingValue :: Value
_existingValue = AnnValue -> Value
unannotateValue AnnValue
existingValue
              , _tableSection :: Table
_tableSection = RawTable -> Table
rawTableToApproxTable RawTable
table
              }

    let newTableMeta :: TableMeta
newTableMeta = TableMeta :: TableType -> TableMeta
TableMeta{tableType :: TableType
tableType = TableType
ExplicitSection}
    AnnValue
newTable <- TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
newTableMeta (AnnTable -> AnnValue)
-> NormalizeM AnnTable -> NormalizeM AnnValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawTable -> NormalizeM AnnTable
flattenTable RawTable
table
    AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnValue -> NormalizeM AnnValue)
-> AnnValue -> NormalizeM AnnValue
forall a b. (a -> b) -> a -> b
$ ArrayMeta -> [AnnValue] -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
arrayMeta
-> [GenericValue map key tableMeta arrayMeta]
-> GenericValue map key tableMeta arrayMeta
GenericArray ArrayMeta
meta ([AnnValue] -> AnnValue) -> [AnnValue] -> AnnValue
forall a b. (a -> b) -> a -> b
$ [AnnValue]
currArray [AnnValue] -> [AnnValue] -> [AnnValue]
forall a. Semigroup a => a -> a -> a
<> [AnnValue
newTable]
  where
    valueAtPathOptions :: ValueAtPathOptions
valueAtPathOptions =
      ValueAtPathOptions :: (TableType -> Bool)
-> TableType
-> (Key -> AnnValue -> NormalizeError)
-> ValueAtPathOptions
ValueAtPathOptions
        { shouldRecurse :: TableType -> Bool
shouldRecurse = \case
            TableType
InlineTable -> Bool
False
            TableType
ImplicitKey -> Bool
False
            TableType
ExplicitSection -> Bool
True
            TableType
ImplicitSection -> Bool
True
        , implicitType :: TableType
implicitType = TableType
ImplicitSection
        , makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError
makeMidPathNotTableError = \Key
history AnnValue
existingValue ->
            NonTableInNestedImplicitArrayError :: Key -> Value -> Key -> Table -> NormalizeError
NonTableInNestedImplicitArrayError
              { _path :: Key
_path = Key
history
              , _existingValue :: Value
_existingValue = AnnValue -> Value
unannotateValue AnnValue
existingValue
              , _sectionKey :: Key
_sectionKey = Key
sectionKey
              , _tableSection :: Table
_tableSection = RawTable -> Table
rawTableToApproxTable RawTable
table
              }
        }

flattenTable :: RawTable -> NormalizeM AnnTable
flattenTable :: RawTable -> NormalizeM AnnTable
flattenTable =
  MergeOptions -> AnnTable -> RawTable -> NormalizeM AnnTable
mergeRawTable
    MergeOptions :: Bool -> MergeOptions
MergeOptions{recurseImplicitSections :: Bool
recurseImplicitSections = Bool
True}
    AnnTable
forall k a. Map k a
Map.empty

data MergeOptions = MergeOptions
  { MergeOptions -> Bool
recurseImplicitSections :: Bool
  }

mergeRawTable :: MergeOptions -> AnnTable -> RawTable -> NormalizeM AnnTable
mergeRawTable :: MergeOptions -> AnnTable -> RawTable -> NormalizeM AnnTable
mergeRawTable MergeOptions{Bool
recurseImplicitSections :: Bool
recurseImplicitSections :: MergeOptions -> Bool
..} AnnTable
baseTable RawTable
table = (AnnTable -> (Key, RawValue) -> NormalizeM AnnTable)
-> AnnTable -> [(Key, RawValue)] -> NormalizeM AnnTable
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM AnnTable -> (Key, RawValue) -> NormalizeM AnnTable
insertRawValue AnnTable
baseTable (RawTable -> [(Key, RawValue)]
forall k v. LookupMap k v -> [(k, v)]
unLookupMap RawTable
table)
  where
    insertRawValue :: AnnTable -> (Key, RawValue) -> NormalizeM AnnTable
insertRawValue AnnTable
accTable (Key
key, RawValue
rawValue) = do
      let valueAtPathOptions :: ValueAtPathOptions
valueAtPathOptions =
            ValueAtPathOptions :: (TableType -> Bool)
-> TableType
-> (Key -> AnnValue -> NormalizeError)
-> ValueAtPathOptions
ValueAtPathOptions
              { shouldRecurse :: TableType -> Bool
shouldRecurse = \case
                  TableType
InlineTable -> Bool
False
                  TableType
ImplicitKey -> Bool
True
                  TableType
ExplicitSection -> Bool
True
                  TableType
ImplicitSection -> Bool
recurseImplicitSections
              , implicitType :: TableType
implicitType = TableType
ImplicitKey
              , makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError
makeMidPathNotTableError = Key -> RawTable -> Key -> AnnValue -> NormalizeError
nonTableInNestedKeyError Key
key RawTable
table
              }
      ValueAtPathOptions
-> Key
-> AnnTable
-> (Maybe AnnValue -> NormalizeM AnnValue)
-> NormalizeM AnnTable
setValueAtPath ValueAtPathOptions
valueAtPathOptions Key
key AnnTable
accTable ((Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable)
-> (Maybe AnnValue -> NormalizeM AnnValue) -> NormalizeM AnnTable
forall a b. (a -> b) -> a -> b
$ \case
        Maybe AnnValue
Nothing -> RawValue -> NormalizeM AnnValue
fromRawValue RawValue
rawValue
        Just AnnValue
existingValue ->
          NormalizeError -> NormalizeM AnnValue
forall a. NormalizeError -> NormalizeM a
normalizeError
            DuplicateKeyError :: Key -> Value -> Value -> NormalizeError
DuplicateKeyError
              { _path :: Key
_path = Key
key
              , _existingValue :: Value
_existingValue = AnnValue -> Value
unannotateValue AnnValue
existingValue
              , _valueToSet :: Value
_valueToSet = RawValue -> Value
rawValueToApproxValue RawValue
rawValue
              }

    fromRawValue :: RawValue -> NormalizeM AnnValue
fromRawValue = \case
      GenericTable ()
_ RawTable
rawTable -> do
        let meta :: TableMeta
meta = TableMeta :: TableType -> TableMeta
TableMeta{tableType :: TableType
tableType = TableType
InlineTable}
        TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
meta (AnnTable -> AnnValue)
-> NormalizeM AnnTable -> NormalizeM AnnValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawTable -> NormalizeM AnnTable
flattenTable RawTable
rawTable
      GenericArray ()
_ [RawValue]
rawValues -> do
        let meta :: ArrayMeta
meta = ArrayMeta :: Bool -> ArrayMeta
ArrayMeta{isStaticArray :: Bool
isStaticArray = Bool
True}
        ArrayMeta -> [AnnValue] -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
arrayMeta
-> [GenericValue map key tableMeta arrayMeta]
-> GenericValue map key tableMeta arrayMeta
GenericArray ArrayMeta
meta ([AnnValue] -> AnnValue)
-> NormalizeM [AnnValue] -> NormalizeM AnnValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RawValue -> NormalizeM AnnValue)
-> [RawValue] -> NormalizeM [AnnValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RawValue -> NormalizeM AnnValue
fromRawValue [RawValue]
rawValues
      GenericString Text
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Text -> GenericValue map key tableMeta arrayMeta
GenericString Text
x)
      GenericInteger Integer
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Integer -> GenericValue map key tableMeta arrayMeta
GenericInteger Integer
x)
      GenericFloat Double
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Double -> GenericValue map key tableMeta arrayMeta
GenericFloat Double
x)
      GenericBoolean Bool
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Bool -> GenericValue map key tableMeta arrayMeta
GenericBoolean Bool
x)
      GenericOffsetDateTime (LocalTime, TimeZone)
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((LocalTime, TimeZone) -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
(LocalTime, TimeZone) -> GenericValue map key tableMeta arrayMeta
GenericOffsetDateTime (LocalTime, TimeZone)
x)
      GenericLocalDateTime LocalTime
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTime -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
LocalTime -> GenericValue map key tableMeta arrayMeta
GenericLocalDateTime LocalTime
x)
      GenericLocalDate Day
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
Day -> GenericValue map key tableMeta arrayMeta
GenericLocalDate Day
x)
      GenericLocalTime TimeOfDay
x -> AnnValue -> NormalizeM AnnValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeOfDay -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
TimeOfDay -> GenericValue map key tableMeta arrayMeta
GenericLocalTime TimeOfDay
x)

data ValueAtPathOptions = ValueAtPathOptions
  { ValueAtPathOptions -> TableType -> Bool
shouldRecurse :: TableType -> Bool
  , ValueAtPathOptions -> TableType
implicitType :: TableType
  , ValueAtPathOptions -> Key -> AnnValue -> NormalizeError
makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError
  }

-- | Implementation for makeMidPathNotTableError for NonTableInNestedKeyError
nonTableInNestedKeyError :: Key -> RawTable -> (Key -> AnnValue -> NormalizeError)
nonTableInNestedKeyError :: Key -> RawTable -> Key -> AnnValue -> NormalizeError
nonTableInNestedKeyError Key
key RawTable
table = \Key
history AnnValue
existingValue ->
  NonTableInNestedKeyError :: Key -> Value -> Key -> Value -> NormalizeError
NonTableInNestedKeyError
    { _path :: Key
_path = Key
history
    , _existingValue :: Value
_existingValue = AnnValue -> Value
unannotateValue AnnValue
existingValue
    , _originalKey :: Key
_originalKey = Key
key
    , _originalValue :: Value
_originalValue = Table -> Value
Table (Table -> Value) -> Table -> Value
forall a b. (a -> b) -> a -> b
$ RawTable -> Table
rawTableToApproxTable RawTable
table
    }

setValueAtPath ::
  ValueAtPathOptions ->
  Key ->
  AnnTable ->
  (Maybe AnnValue -> NormalizeM AnnValue) ->
  NormalizeM AnnTable
setValueAtPath :: ValueAtPathOptions
-> Key
-> AnnTable
-> (Maybe AnnValue -> NormalizeM AnnValue)
-> NormalizeM AnnTable
setValueAtPath ValueAtPathOptions{TableType
Key -> AnnValue -> NormalizeError
TableType -> Bool
makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError
implicitType :: TableType
shouldRecurse :: TableType -> Bool
makeMidPathNotTableError :: ValueAtPathOptions -> Key -> AnnValue -> NormalizeError
implicitType :: ValueAtPathOptions -> TableType
shouldRecurse :: ValueAtPathOptions -> TableType -> Bool
..} Key
fullKey AnnTable
initialTable Maybe AnnValue -> NormalizeM AnnValue
f = do
  (Maybe AnnValue
mValue, AnnValue -> AnnTable
setValue) <- (Key
 -> Maybe AnnValue -> NormalizeM (AnnTable, AnnTable -> AnnValue))
-> Key
-> AnnTable
-> NormalizeM (Maybe AnnValue, AnnValue -> AnnTable)
forall (m :: * -> *) k v.
(Monad m, Ord k) =>
(NonEmpty k -> Maybe v -> m (Map k v, Map k v -> v))
-> NonEmpty k -> Map k v -> m (Maybe v, v -> Map k v)
getPathLens Key
-> Maybe AnnValue -> NormalizeM (AnnTable, AnnTable -> AnnValue)
doRecurse Key
fullKey AnnTable
initialTable
  AnnValue -> AnnTable
setValue (AnnValue -> AnnTable)
-> NormalizeM AnnValue -> NormalizeM AnnTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AnnValue -> NormalizeM AnnValue
f Maybe AnnValue
mValue
  where
    doRecurse :: Key
-> Maybe AnnValue -> NormalizeM (AnnTable, AnnTable -> AnnValue)
doRecurse Key
history = \case
      -- If nothing exists, recurse into a new empty Map
      Maybe AnnValue
Nothing -> do
        let newTableMeta :: TableMeta
newTableMeta = TableMeta :: TableType -> TableMeta
TableMeta{tableType :: TableType
tableType = TableType
implicitType}
        (AnnTable, AnnTable -> AnnValue)
-> NormalizeM (AnnTable, AnnTable -> AnnValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnTable
forall k a. Map k a
Map.empty, TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
newTableMeta)
      -- If a Table exists, recurse into it
      Just (GenericTable TableMeta
meta AnnTable
subTable) -> do
        Bool -> NormalizeM () -> NormalizeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TableType -> Bool
shouldRecurse (TableType -> Bool) -> TableType -> Bool
forall a b. (a -> b) -> a -> b
$ TableMeta -> TableType
tableType TableMeta
meta) (NormalizeM () -> NormalizeM ()) -> NormalizeM () -> NormalizeM ()
forall a b. (a -> b) -> a -> b
$
          NormalizeError -> NormalizeM ()
forall a. NormalizeError -> NormalizeM a
normalizeError
            ExtendTableError :: Key -> Key -> NormalizeError
ExtendTableError
              { _path :: Key
_path = Key
history
              , _originalKey :: Key
_originalKey = Key
fullKey
              }
        (AnnTable, AnnTable -> AnnValue)
-> NormalizeM (AnnTable, AnnTable -> AnnValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnTable
subTable, TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
meta)
      -- If an Array exists, recurse into the last Table, per spec:
      --   Any reference to an array of tables points to the
      --   most recently defined table element of the array.
      Just (GenericArray ArrayMeta
aMeta [AnnValue]
vs)
        | Just NonEmpty AnnValue
vs' <- [AnnValue] -> Maybe (NonEmpty AnnValue)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [AnnValue]
vs
        , GenericTable TableMeta
tMeta AnnTable
subTable <- NonEmpty AnnValue -> AnnValue
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty AnnValue
vs' -> do
            Bool -> NormalizeM () -> NormalizeM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ArrayMeta -> Bool
isStaticArray ArrayMeta
aMeta) (NormalizeM () -> NormalizeM ()) -> NormalizeM () -> NormalizeM ()
forall a b. (a -> b) -> a -> b
$
              NormalizeError -> NormalizeM ()
forall a. NormalizeError -> NormalizeM a
normalizeError (NormalizeError -> NormalizeM ())
-> NormalizeError -> NormalizeM ()
forall a b. (a -> b) -> a -> b
$
                Key -> Key -> NormalizeError
ExtendTableInInlineArrayError Key
history Key
fullKey
            (AnnTable, AnnTable -> AnnValue)
-> NormalizeM (AnnTable, AnnTable -> AnnValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnTable
subTable, ArrayMeta -> [AnnValue] -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
arrayMeta
-> [GenericValue map key tableMeta arrayMeta]
-> GenericValue map key tableMeta arrayMeta
GenericArray ArrayMeta
aMeta ([AnnValue] -> AnnValue)
-> (AnnTable -> [AnnValue]) -> AnnTable -> AnnValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnnValue] -> AnnValue -> [AnnValue]
forall a. [a] -> a -> [a]
snoc (NonEmpty AnnValue -> [AnnValue]
forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty AnnValue
vs') (AnnValue -> [AnnValue])
-> (AnnTable -> AnnValue) -> AnnTable -> [AnnValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMeta -> AnnTable -> AnnValue
forall (map :: * -> * -> *) key tableMeta arrayMeta.
tableMeta
-> map key (GenericValue map key tableMeta arrayMeta)
-> GenericValue map key tableMeta arrayMeta
GenericTable TableMeta
tMeta)
      -- If something else exists, throw error with makeMidPathNotTableError
      Just AnnValue
v -> NormalizeError -> NormalizeM (AnnTable, AnnTable -> AnnValue)
forall a. NormalizeError -> NormalizeM a
normalizeError (NormalizeError -> NormalizeM (AnnTable, AnnTable -> AnnValue))
-> NormalizeError -> NormalizeM (AnnTable, AnnTable -> AnnValue)
forall a b. (a -> b) -> a -> b
$ Key -> AnnValue -> NormalizeError
makeMidPathNotTableError Key
history AnnValue
v

    snoc :: [a] -> a -> [a]
snoc [a]
xs a
x = [a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
x]

-- | Convert a RawTable into a Table, for use in errors + debugging.
rawTableToApproxTable :: RawTable -> Table
rawTableToApproxTable :: RawTable -> Table
rawTableToApproxTable =
  [(Text, Value)] -> Table
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(Text, Value)] -> Table)
-> (RawTable -> [(Text, Value)]) -> RawTable -> Table
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, RawValue) -> (Text, Value))
-> [(Key, RawValue)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, RawValue
v) -> (Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Key -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList Key
k, RawValue -> Value
rawValueToApproxValue RawValue
v))
    ([(Key, RawValue)] -> [(Text, Value)])
-> (RawTable -> [(Key, RawValue)]) -> RawTable -> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawTable -> [(Key, RawValue)]
forall k v. LookupMap k v -> [(k, v)]
unLookupMap

-- | Convert a RawValue into a Value, for use in errors + debugging.
rawValueToApproxValue :: RawValue -> Value
rawValueToApproxValue :: RawValue -> Value
rawValueToApproxValue = (RawTable -> Table) -> RawValue -> Value
forall (map :: * -> * -> *) key tableMeta arrayMeta.
(map key (GenericValue map key tableMeta arrayMeta) -> Table)
-> GenericValue map key tableMeta arrayMeta -> Value
fromGenericValue RawTable -> Table
rawTableToApproxTable

{--- Parser Helpers ---}

-- | https://github.com/toml-lang/toml/blob/1.0.0/toml.abnf#L38
isNonAscii :: Char -> Bool
isNonAscii :: Char -> Bool
isNonAscii Char
c = (Int
0x80 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xD7FF) Bool -> Bool -> Bool
|| (Int
0xE000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)
  where
    code :: Int
code = Char -> Int
ord Char
c

-- | https://unicode.org/glossary/#unicode_scalar_value
isUnicodeScalar :: Int -> Bool
isUnicodeScalar :: Int -> Bool
isUnicodeScalar Int
code = (Int
0x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xD7FF) Bool -> Bool -> Bool
|| (Int
0xE000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)

-- | Returns "", "-", or "+"
parseSignRaw :: Parser Text
parseSignRaw :: ParsecT Void Text Identity Text
parseSignRaw = Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. a -> Parser a -> Parser a
optionalOr Text
"" (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"-" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"+")

parseSign :: Num a => Parser (a -> a)
parseSign :: Parser (a -> a)
parseSign = do
  Text
sign <- ParsecT Void Text Identity Text
parseSignRaw
  (a -> a) -> Parser (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> a) -> Parser (a -> a)) -> (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ if Text
sign Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-" then a -> a
forall a. Num a => a -> a
negate else a -> a
forall a. a -> a
id

parseDecIntRaw :: Parser Text
parseDecIntRaw :: ParsecT Void Text Identity Text
parseDecIntRaw =
  [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
parseNumRaw ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text))
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isDigit Char
Token Text
c Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0') ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    , Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    ]

parseDecDigits :: (Show a, Num a, Eq a) => Int -> Parser a
parseDecDigits :: Int -> Parser a
parseDecDigits Int
n = Text -> a
forall a. (Show a, Num a, Eq a) => Text -> a
readDec (Text -> a) -> (String -> Text) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> a) -> ParsecT Void Text Identity String -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

parseNumRaw :: Parser Char -> Parser Char -> Parser Text
parseNumRaw :: ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
parseNumRaw ParsecT Void Text Identity Char
parseLeadingDigit ParsecT Void Text Identity Char
parseDigit = do
  Char
leading <- ParsecT Void Text Identity Char
parseLeadingDigit
  String
rest <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') ParsecT Void Text Identity (Maybe Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
parseDigit
  Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
leading Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest

{--- Parser Utilities ---}

hsymbol :: Text -> Parser ()
hsymbol :: Text -> Parser ()
hsymbol Text
s = Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
s ParsecT Void Text Identity Text -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse trailing whitespace/trailing comments + newline
endOfLine :: Parser ()
endOfLine :: Parser ()
endOfLine = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 Parser ()
skipComments Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse spaces, newlines, and comments
emptyLines :: Parser ()
emptyLines :: Parser ()
emptyLines = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
space1 Parser ()
skipComments Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty

skipComments :: Parser ()
skipComments :: Parser ()
skipComments = do
  Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#"
  ParsecT Void Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> Parser ())
-> (Parser () -> ParsecT Void Text Identity [()])
-> Parser ()
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> ParsecT Void Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Char
c <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
    let code :: Int
code = Char -> Int
ord Char
c
    case Char
c of
      Char
'\r' -> ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> Parser ())
-> ParsecT Void Text Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n')
      Char
_
        | (Int
0x00 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x08) Bool -> Bool -> Bool
|| (Int
0x0A Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
code Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x1F) Bool -> Bool -> Bool
|| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x7F ->
            String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Comment has invalid character: \\" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
code
      Char
_ -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

space, space1 :: Parser ()
space :: Parser ()
space = ParsecT Void Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> Parser ())
-> ParsecT Void Text Identity [()] -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> ParsecT Void Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
parseSpace
space1 :: Parser ()
space1 = ParsecT Void Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> Parser ())
-> ParsecT Void Text Identity [()] -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> ParsecT Void Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser ()
parseSpace

-- | TOML does not support bare '\r' without '\n'.
parseSpace :: Parser ()
parseSpace :: Parser ()
parseSpace = ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char -> Bool
isSpace Char
Token Text
c Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\r\n")

#if !MIN_VERSION_megaparsec(9,0,0)
hspace :: Parser ()
hspace = void $ takeWhileP (Just "white space") isHSpace

hspace1 :: Parser ()
hspace1 = void $ takeWhile1P (Just "white space") isHSpace

isHSpace :: Char -> Bool
isHSpace x = isSpace x && x /= '\n' && x /= '\r'
#endif

optionalOr :: a -> Parser a -> Parser a
optionalOr :: a -> Parser a -> Parser a
optionalOr a
def = (Maybe a -> a) -> ParsecT Void Text Identity (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) (ParsecT Void Text Identity (Maybe a) -> Parser a)
-> (Parser a -> ParsecT Void Text Identity (Maybe a))
-> Parser a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ParsecT Void Text Identity (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional

exactly :: Int -> Char -> Parser Text
exactly :: Int -> Char -> ParsecT Void Text Identity Text
exactly Int
n Char
c = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
c) ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
c)

{--- Read Helpers ---}

-- | Assumes string satisfies @all isDigit@.
readFloat :: (Show a, RealFrac a) => Text -> a
readFloat :: Text -> a
readFloat = ReadS a -> Text -> a
forall a. Show a => ReadS a -> Text -> a
runReader ReadS a
forall a. RealFrac a => ReadS a
Numeric.readFloat

-- | Assumes string satisfies @all isDigit@.
readDec :: (Show a, Num a, Eq a) => Text -> a
readDec :: Text -> a
readDec = ReadS a -> Text -> a
forall a. Show a => ReadS a -> Text -> a
runReader ReadS a
forall a. (Eq a, Num a) => ReadS a
Numeric.readDec

-- | Assumes string satisfies @all isHexDigit@.
readHex :: (Show a, Num a, Eq a) => Text -> a
readHex :: Text -> a
readHex = ReadS a -> Text -> a
forall a. Show a => ReadS a -> Text -> a
runReader ReadS a
forall a. (Eq a, Num a) => ReadS a
Numeric.readHex

-- | Assumes string satisfies @all isOctDigit@.
readOct :: (Show a, Num a, Eq a) => Text -> a
readOct :: Text -> a
readOct = ReadS a -> Text -> a
forall a. Show a => ReadS a -> Text -> a
runReader ReadS a
forall a. (Eq a, Num a) => ReadS a
Numeric.readOct

-- | Assumes string satisfies @all (`elem` "01")@.
readBin :: (Show a, Num a) => Text -> a
readBin :: Text -> a
readBin = (a -> Char -> a) -> a -> String -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Char -> a
forall a. Num a => a -> Char -> a
go a
0 (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
  where
    go :: a -> Char -> a
go a
acc Char
x =
      let digit :: a
digit
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' = a
0
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' = a
1
            | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"readBin got unexpected digit: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
x
       in a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
digit

runReader :: Show a => ReadS a -> Text -> a
runReader :: ReadS a -> Text -> a
runReader ReadS a
rdr Text
digits =
  case ReadS a
rdr ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
digits of
    [(a
x, String
"")] -> a
x
    [(a, String)]
result -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Unexpectedly unable to parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
digits String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(a, String)] -> String
forall a. Show a => a -> String
show [(a, String)]
result