{- |
Module                  : Toml.Parser.Value
Copyright               : (c) 2018-2022 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

Parser for 'UValue'.
-}

module Toml.Parser.Value
       ( arrayP
       , boolP
       , dateTimeP
       , doubleP
       , integerP
       , valueP
       , anyValueP
       ) where

import Control.Applicative (Alternative (..))
import Control.Applicative.Combinators (between, count, option, optional, sepBy1, sepEndBy,
                                        skipMany)
import Data.Fixed (Pico)
import Data.Time (Day, LocalTime (..), TimeOfDay, ZonedTime (..), fromGregorianValid,
                  makeTimeOfDayValid, minutesToTimeZone)
import Data.String (fromString)

import Text.Read (readMaybe)
import Text.Megaparsec (observing, parseMaybe)

import Toml.Parser.Core (Parser, char, digitChar, hexDigitChar, octDigitChar, binDigitChar, hexadecimal, octal, binary, lexeme, sc, signed,
                         string, text, try, (<?>))
import Toml.Parser.String (textP)
import Toml.Type (AnyValue, UValue (..), typeCheck)


-- | Parser for decimap 'Integer': included parsing of underscore.
decimalP :: Parser Integer
decimalP :: Parser Integer
decimalP = do
        Either (ParseError Text Void) [Char]
value <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
observing forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser [Char]
leadingZeroP
        case Either (ParseError Text Void) [Char]
value of
          Left ParseError Text Void
_ -> do
            forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Integer
more
          Right [Char]
_ -> 
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Leading zero."

  where
    leadingZeroP :: Parser String
    leadingZeroP :: Parser [Char]
leadingZeroP = do
               forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
count Int
1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'0') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[Token Text]
_ -> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)

    more :: Parser Integer
    more :: Parser Integer
more  = Maybe Integer -> Parser Integer
check forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Read a => [Char] -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')

    check :: Maybe Integer -> Parser Integer
    check :: Maybe Integer -> Parser Integer
check = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not an integer") forall (f :: * -> *) a. Applicative f => a -> f a
pure



-- | Parser for hexadecimal, octal and binary numbers : included parsing
numberP :: Parser Integer -> Parser Char -> String -> Parser Integer
numberP :: Parser Integer -> Parser Char -> [Char] -> Parser Integer
numberP Parser Integer
parseInteger Parser Char
parseDigit [Char]
errorMessage = Parser Integer
more
  where
    more :: Parser Integer
    more :: Parser Integer
more = Maybe Integer -> Parser Integer
check forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> Maybe Integer
intValueMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Char
parseDigit) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')

    intValueMaybe :: String -> Maybe Integer
    intValueMaybe :: [Char] -> Maybe Integer
intValueMaybe = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parser Integer
parseInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString

    check :: Maybe Integer -> Parser Integer
    check :: Maybe Integer -> Parser Integer
check = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
errorMessage) forall (f :: * -> *) a. Applicative f => a -> f a
pure



-- | Parser for 'Integer' value.
integerP :: Parser Integer
integerP :: Parser Integer
integerP = forall a. Parser a -> Parser a
lexeme (Parser Integer
bin forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
oct forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
hex forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
dec) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"integer"
  where
    bin, oct, hex, dec :: Parser Integer
    bin :: Parser Integer
bin = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'b') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
binaryP      forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"bin"
    oct :: Parser Integer
oct = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'o') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
octalP       forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"oct"
    hex :: Parser Integer
hex = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'0' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'x') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
hexadecimalP forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"hex"
    dec :: Parser Integer
dec = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed Parser ()
sc Parser Integer
decimalP                        forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"dec"
    binaryP :: Parser Integer
binaryP = Parser Integer -> Parser Char -> [Char] -> Parser Integer
numberP forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
binDigitChar [Char]
"Invalid binary number"
    octalP :: Parser Integer
octalP  = Parser Integer -> Parser Char -> [Char] -> Parser Integer
numberP forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
octal forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar  [Char]
"Invalid ocatl number"
    hexadecimalP :: Parser Integer
hexadecimalP = Parser Integer -> Parser Char -> [Char] -> Parser Integer
numberP forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar [Char]
"Invalid hexadecimal number"

-- | Parser for 'Double' value.
doubleP :: Parser Double
doubleP :: Parser Double
doubleP = forall a. Parser a -> Parser a
lexeme (forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed Parser ()
sc (Parser Double
num forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
inf forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
nan)) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"double"
  where
    num, inf, nan :: Parser Double
    num :: Parser Double
num = Parser Double
floatP
    inf :: Parser Double
inf = Double
1 forall a. Fractional a => a -> a -> a
/ Double
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"inf"
    nan :: Parser Double
nan = Double
0 forall a. Fractional a => a -> a -> a
/ Double
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"nan"

-- | Parser for 'Double' numbers. Used in 'doubleP'.
floatP :: Parser Double
floatP :: Parser Double
floatP = Maybe Double -> Parser Double
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> Maybe a
readMaybe forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Monoid a => [a] -> a
mconcat [ Parser [Char]
digits, Parser [Char]
expo forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [Char]
dot ]
  where
    check :: Maybe Double -> Parser Double
    check :: Maybe Double -> Parser Double
check = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not a float") forall (m :: * -> *) a. Monad m => a -> m a
return

    digits, dot, expo :: Parser String
    digits :: Parser [Char]
digits = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')
    dot :: Parser [Char]
dot = forall a. Monoid a => [a] -> a
mconcat [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.', Parser [Char]
digits, forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [Char]
"" Parser [Char]
expo]
    expo :: Parser [Char]
expo = forall a. Monoid a => [a] -> a
mconcat
        [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'e' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'E')
        , forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Char
'+' (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-')
        , Parser [Char]
digits
        ]

-- | Parser for 'Bool' value.
boolP :: Parser Bool
boolP :: Parser Bool
boolP = Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"false"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
True  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
text Text
"true"
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"bool"

-- | Parser for datetime values.
dateTimeP :: Parser UValue
dateTimeP :: Parser UValue
dateTimeP = forall a. Parser a -> Parser a
lexeme (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TimeOfDay -> UValue
UHours forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
hoursP) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UValue
dayLocalZoned) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"datetime"

-- dayLocalZoned can parse: only a local date, a local date with time, or
-- a local date with a time and an offset
dayLocalZoned :: Parser UValue
dayLocalZoned :: Parser UValue
dayLocalZoned = do
    Day
day        <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Day
dayP
    Maybe TimeOfDay
maybeHours <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'T' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TimeOfDay
hoursP)
    case Maybe TimeOfDay
maybeHours of
        Maybe TimeOfDay
Nothing    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Day -> UValue
UDay Day
day
        Just TimeOfDay
hours -> do
            Maybe Int
maybeOffset <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Int
timeOffsetP)
            let localTime :: LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
hours
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Maybe Int
maybeOffset of
                Maybe Int
Nothing     -> LocalTime -> UValue
ULocal LocalTime
localTime
                Just Int
offset -> ZonedTime -> UValue
UZoned forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
localTime (Int -> TimeZone
minutesToTimeZone Int
offset)

-- | Parser for time-zone offset
timeOffsetP :: Parser Int
timeOffsetP :: Parser Int
timeOffsetP = Parser Int
z forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int
numOffset
  where
    z :: Parser Int
    z :: Parser Int
z = Int
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'Z'

    numOffset :: Parser Int
    numOffset :: Parser Int
numOffset = do
        Char
sign    <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-'
        Int
hours   <- Parser Int
int2DigitsP
        Token Text
_       <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
        Int
minutes <- Parser Int
int2DigitsP
        let totalMinutes :: Int
totalMinutes = Int
hours forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
minutes
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Char
sign forall a. Eq a => a -> a -> Bool
== Char
'+'
            then Int
totalMinutes
            else forall a. Num a => a -> a
negate Int
totalMinutes

-- | Parser for offset in day.
hoursP :: Parser TimeOfDay
hoursP :: Parser TimeOfDay
hoursP = do
    Int
hours   <- Parser Int
int2DigitsP
    Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
    Int
minutes <- Parser Int
int2DigitsP
    Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
    Pico
seconds <- Parser Pico
picoTruncated
    case Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
hours Int
minutes Pico
seconds of
        Just TimeOfDay
time -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
time
        Maybe TimeOfDay
Nothing   -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
           [Char]
"Invalid time of day: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
hours forall a. Semigroup a => a -> a -> a
<> [Char]
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
minutes forall a. Semigroup a => a -> a -> a
<> [Char]
":" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Pico
seconds

-- | Parser for 'Day'.
dayP :: Parser Day
dayP :: Parser Day
dayP = do
    Integer
year  <- Parser Integer
yearP
    Token Text
_     <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-'
    Int
month <- Parser Int
int2DigitsP
    Token Text
_     <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-'
    Int
day   <- Parser Int
int2DigitsP
    case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
        Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
date
        Maybe Day
Nothing   -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
            [Char]
"Invalid date: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Integer
year forall a. Semigroup a => a -> a -> a
<> [Char]
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
month forall a. Semigroup a => a -> a -> a
<> [Char]
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
day

-- | Parser for exactly 4 integer digits.
yearP :: Parser Integer
yearP :: Parser Integer
yearP = forall a. Read a => [Char] -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
count Int
4 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

-- | Parser for exactly two digits. Used to parse months or hours.
int2DigitsP :: Parser Int
int2DigitsP :: Parser Int
int2DigitsP = forall a. Read a => [Char] -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
count Int
2 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

-- | Parser for pico-chu.
picoTruncated :: Parser Pico
picoTruncated :: Parser Pico
picoTruncated = do
    [Char]
int <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
count Int
2 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    Maybe [Char]
frc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Int -> [a] -> [a]
take Int
12 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Read a => [Char] -> a
read forall a b. (a -> b) -> a -> b
$ case Maybe [Char]
frc of
        Maybe [Char]
Nothing   -> [Char]
int
        Just [Char]
frc' -> [Char]
int forall a. [a] -> [a] -> [a]
++ [Char]
"." forall a. [a] -> [a] -> [a]
++ [Char]
frc'

{- | Parser for array of values. This parser tries to parse first element of
array, pattern-matches on this element and uses parser according to this first
element. This allows to prevent parsing of heterogeneous arrays.
-}
arrayP :: Parser [UValue]
arrayP :: Parser [UValue]
arrayP = forall a. Parser a -> Parser a
lexeme (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sc) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') Parser [UValue]
elements) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"array"
  where
    elements :: Parser [UValue]
    elements :: Parser [UValue]
elements = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] forall a b. (a -> b) -> a -> b
$ do -- Zero or more elements
        UValue
v   <- Parser UValue
valueP -- Parse the first value to determine the type
        Maybe ()
sep <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ()
spComma
        [UValue]
vs  <- case Maybe ()
sep of
            Maybe ()
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Just ()
_  -> (UValue -> Parser UValue
element UValue
v forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepEndBy` Parser ()
spComma) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) a. Alternative m => m a -> m ()
skipMany Parser ()
spComma
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (UValue
vforall a. a -> [a] -> [a]
:[UValue]
vs)

    element :: UValue -> Parser UValue
    element :: UValue -> Parser UValue
element = \case
        UBool    Bool
_ -> Bool -> UValue
UBool    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
boolP
        UZoned   ZonedTime
_ -> Parser UValue
dayLocalZoned
        ULocal   LocalTime
_ -> Parser UValue
dayLocalZoned
        UDay     Day
_ -> Day -> UValue
UDay     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
dayP
        UHours   TimeOfDay
_ -> TimeOfDay -> UValue
UHours   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
hoursP
        UDouble  Double
_ -> Double -> UValue
UDouble  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Double
doubleP
        UInteger Integer
_ -> Integer -> UValue
UInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
integerP
        UText    Text
_ -> Text -> UValue
UText    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
textP
        UArray   [UValue]
_ -> [UValue] -> UValue
UArray   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [UValue]
arrayP

    spComma :: Parser ()
    spComma :: Parser ()
spComma = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
sc

-- | Parser for 'UValue'.
valueP :: Parser UValue
valueP :: Parser UValue
valueP = Text -> UValue
UText    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
textP
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> UValue
UBool    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
boolP
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [UValue] -> UValue
UArray   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [UValue]
arrayP
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UValue
dateTimeP
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> UValue
UDouble  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Double
doubleP
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> UValue
UInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
integerP

-- | Uses 'valueP' and typechecks it.
anyValueP :: Parser AnyValue
anyValueP :: Parser AnyValue
anyValueP = UValue -> Either TypeMismatchError AnyValue
typeCheck forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UValue
valueP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left TypeMismatchError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show TypeMismatchError
err
    Right AnyValue
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AnyValue
v