-- | 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.Semigroup ((<>))
import Data.Time (Day, LocalTime (..), TimeOfDay, ZonedTime (..), fromGregorianValid,
                  makeTimeOfDayValid, minutesToTimeZone)
import Text.Read (readMaybe)

import Toml.Parser.Core (Parser, binary, char, digitChar, hexadecimal, lexeme, octal, 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 = Parser Integer
zero Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
more
  where
    zero, more :: Parser Integer
    zero :: Parser Integer
zero  = 0 Integer -> ParsecT Void Text Identity Char -> Parser Integer
forall (f :: * -> *) a b. Functor f => a -> f b -> 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 Token Text
'0'
    more :: Parser Integer
more  = Maybe Integer -> Parser Integer
check (Maybe Integer -> Parser Integer)
-> ParsecT Void Text Identity (Maybe Integer) -> Parser Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> ([String] -> String) -> [String] -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> Maybe Integer)
-> ParsecT Void Text Identity [String]
-> ParsecT Void Text Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [String]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1 (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) (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 Token Text
'_')

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

-- | Parser for 'Integer' value.
integerP :: Parser Integer
integerP :: Parser Integer
integerP = Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
lexeme (Parser Integer
bin Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
oct Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
hex Parser Integer -> Parser Integer -> Parser Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
dec) Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "integer"
  where
    bin, oct, hex, dec :: Parser Integer
    bin :: Parser Integer
bin = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 Token Text
'0' 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
*> 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 Token Text
'b') ParsecT Void Text Identity Char -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
m a
binary      Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "bin"
    oct :: Parser Integer
oct = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 Token Text
'0' 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
*> 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 Token Text
'o') ParsecT Void Text Identity Char -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
m a
octal       Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "oct"
    hex :: Parser Integer
hex = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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 Token Text
'0' 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
*> 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 Token Text
'x') ParsecT Void Text Identity Char -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
m a
hexadecimal Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "hex"
    dec :: Parser Integer
dec = ParsecT Void Text Identity () -> Parser Integer -> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed ParsecT Void Text Identity ()
sc Parser Integer
decimalP                        Parser Integer -> String -> Parser Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "dec"

-- | Parser for 'Double' value.
doubleP :: Parser Double
doubleP :: Parser Double
doubleP = Parser Double -> Parser Double
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity () -> Parser Double -> Parser Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed ParsecT Void Text Identity ()
sc (Parser Double
num Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
inf Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
nan)) Parser Double -> String -> Parser Double
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "double"
  where
    num, inf, nan :: Parser Double
    num :: Parser Double
num = Parser Double
floatP
    inf :: Parser Double
inf = 1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 0 Double -> ParsecT Void Text Identity Text -> Parser Double
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 "inf"
    nan :: Parser Double
nan = 0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 0 Double -> ParsecT Void Text Identity Text -> Parser Double
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 "nan"

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

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

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

-- | Parser for datetime values.
dateTimeP :: Parser UValue
dateTimeP :: Parser UValue
dateTimeP = Parser UValue -> Parser UValue
forall a. Parser a -> Parser a
lexeme (Parser UValue -> Parser UValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TimeOfDay -> UValue
UHours (TimeOfDay -> UValue)
-> ParsecT Void Text Identity TimeOfDay -> Parser UValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity TimeOfDay
hoursP) Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UValue
dayLocalZoned) Parser UValue -> String -> Parser UValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "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        <- ParsecT Void Text Identity Day -> ParsecT Void Text Identity Day
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Day
dayP
    Maybe TimeOfDay
maybeHours <- ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity (Maybe TimeOfDay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity TimeOfDay
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity TimeOfDay
 -> ParsecT Void Text Identity TimeOfDay)
-> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity TimeOfDay
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 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 Token Text
' ') ParsecT Void Text Identity Char
-> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity TimeOfDay
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity TimeOfDay
hoursP)
    case Maybe TimeOfDay
maybeHours of
        Nothing    -> UValue -> Parser UValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UValue -> Parser UValue) -> UValue -> Parser UValue
forall a b. (a -> b) -> a -> b
$ Day -> UValue
UDay Day
day
        Just hours :: TimeOfDay
hours -> do
            Maybe Int
maybeOffset <- ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Int
timeOffsetP)
            let localTime :: LocalTime
localTime = Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
hours
            UValue -> Parser UValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UValue -> Parser UValue) -> UValue -> Parser UValue
forall a b. (a -> b) -> a -> b
$ case Maybe Int
maybeOffset of
                Nothing     -> LocalTime -> UValue
ULocal LocalTime
localTime
                Just offset :: Int
offset -> ZonedTime -> UValue
UZoned (ZonedTime -> UValue) -> ZonedTime -> UValue
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 :: ParsecT Void Text Identity Int
timeOffsetP = ParsecT Void Text Identity Int
z ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Int
numOffset
  where
    z :: Parser Int
    z :: ParsecT Void Text Identity Int
z = 0 Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Int
forall (f :: * -> *) a b. Functor f => a -> f b -> 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 Token Text
'Z'

    numOffset :: Parser Int
    numOffset :: ParsecT Void Text Identity Int
numOffset = do
        Char
sign    <- 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 Token Text
'+' 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 Token Text
'-'
        Int
hours   <- ParsecT Void Text Identity Int
int2DigitsP
        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 Token Text
':'
        Int
minutes <- ParsecT Void Text Identity Int
int2DigitsP
        let totalMinutes :: Int
totalMinutes = Int
hours Int -> Int -> Int
forall a. Num a => a -> a -> a
* 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minutes
        Int -> ParsecT Void Text Identity Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ParsecT Void Text Identity Int)
-> Int -> ParsecT Void Text Identity Int
forall a b. (a -> b) -> a -> b
$ if Char
sign Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+'
            then Int
totalMinutes
            else Int -> Int
forall a. Num a => a -> a
negate Int
totalMinutes

-- | Parser for offset in day.
hoursP :: Parser TimeOfDay
hoursP :: ParsecT Void Text Identity TimeOfDay
hoursP = do
    Int
hours   <- ParsecT Void Text Identity Int
int2DigitsP
    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 Token Text
':'
    Int
minutes <- ParsecT Void Text Identity Int
int2DigitsP
    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 Token Text
':'
    Pico
seconds <- Parser Pico
picoTruncated
    case Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
hours Int
minutes Pico
seconds of
        Just time :: TimeOfDay
time -> TimeOfDay -> ParsecT Void Text Identity TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
time
        Nothing   -> String -> ParsecT Void Text Identity TimeOfDay
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity TimeOfDay)
-> String -> ParsecT Void Text Identity TimeOfDay
forall a b. (a -> b) -> a -> b
$
           "Invalid time of day: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
hours String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
minutes String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Pico -> String
forall a. Show a => a -> String
show Pico
seconds

-- | Parser for 'Day'.
dayP :: Parser Day
dayP :: ParsecT Void Text Identity Day
dayP = do
    Integer
year  <- Parser Integer
yearP
    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 Token Text
'-'
    Int
month <- ParsecT Void Text Identity Int
int2DigitsP
    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 Token Text
'-'
    Int
day   <- ParsecT Void Text Identity Int
int2DigitsP
    case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
        Just date :: Day
date -> Day -> ParsecT Void Text Identity Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
date
        Nothing   -> String -> ParsecT Void Text Identity Day
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text Identity Day)
-> String -> ParsecT Void Text Identity Day
forall a b. (a -> b) -> a -> b
$
            "Invalid date: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
year String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
month String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
day

-- | Parser for exactly 4 integer digits.
yearP :: Parser Integer
yearP :: Parser Integer
yearP = String -> Integer
forall a. Read a => String -> a
read (String -> Integer)
-> ParsecT Void Text Identity String -> Parser Integer
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. Applicative m => Int -> m a -> m [a]
count 4 ParsecT Void Text Identity Char
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 :: ParsecT Void Text Identity Int
int2DigitsP = String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Int
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. Applicative m => Int -> m a -> m [a]
count 2 ParsecT Void Text Identity Char
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
    String
int <- Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
count 2 ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
    Maybe String
frc <- ParsecT Void Text Identity String
-> ParsecT Void Text Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity String
 -> ParsecT Void Text Identity (Maybe String))
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity (Maybe String)
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 Token Text
'.' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> String -> String
forall a. Int -> [a] -> [a]
take 12 (String -> String)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    Pico -> Parser Pico
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pico -> Parser Pico) -> Pico -> Parser Pico
forall a b. (a -> b) -> a -> b
$ String -> Pico
forall a. Read a => String -> a
read (String -> Pico) -> String -> Pico
forall a b. (a -> b) -> a -> b
$ case Maybe String
frc of
        Nothing   -> String
int
        Just frc' :: String
frc' -> String
int String -> String -> String
forall a. [a] -> [a] -> [a]
++ "." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 = Parser [UValue] -> Parser [UValue]
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Char
-> Parser [UValue]
-> Parser [UValue]
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 Token Text
'[' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
sc) (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 Token Text
']') Parser [UValue]
elements) Parser [UValue] -> String -> Parser [UValue]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "array"
  where
    elements :: Parser [UValue]
    elements :: Parser [UValue]
elements = [UValue] -> Parser [UValue] -> Parser [UValue]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (Parser [UValue] -> Parser [UValue])
-> Parser [UValue] -> Parser [UValue]
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 <- ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity ()
spComma
        [UValue]
vs  <- case Maybe ()
sep of
            Nothing -> [UValue] -> Parser [UValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Just _  -> (UValue -> Parser UValue
element UValue
v Parser UValue -> ParsecT Void Text Identity () -> Parser [UValue]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepEndBy` ParsecT Void Text Identity ()
spComma) Parser [UValue] -> ParsecT Void Text Identity () -> Parser [UValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (m :: * -> *) a. Alternative m => m a -> m ()
skipMany ParsecT Void Text Identity ()
spComma
        [UValue] -> Parser [UValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UValue
vUValue -> [UValue] -> [UValue]
forall a. a -> [a] -> [a]
:[UValue]
vs)

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

    spComma :: Parser ()
    spComma :: ParsecT Void Text Identity ()
spComma = 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 Token Text
',' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
sc

-- | Parser for 'UValue'.
valueP :: Parser UValue
valueP :: Parser UValue
valueP = Text -> UValue
UText    (Text -> UValue)
-> ParsecT Void Text Identity Text -> Parser UValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
textP
     Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> UValue
UBool    (Bool -> UValue) -> Parser Bool -> Parser UValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
boolP
     Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [UValue] -> UValue
UArray   ([UValue] -> UValue) -> Parser [UValue] -> Parser UValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [UValue]
arrayP
     Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UValue
dateTimeP
     Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> UValue
UDouble  (Double -> UValue) -> Parser Double -> Parser UValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double -> Parser Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Double
doubleP
     Parser UValue -> Parser UValue -> Parser UValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> UValue
UInteger (Integer -> UValue) -> Parser Integer -> Parser UValue
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 (UValue -> Either TypeMismatchError AnyValue)
-> Parser UValue
-> ParsecT Void Text Identity (Either TypeMismatchError AnyValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UValue
valueP ParsecT Void Text Identity (Either TypeMismatchError AnyValue)
-> (Either TypeMismatchError AnyValue -> Parser AnyValue)
-> Parser AnyValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left err :: TypeMismatchError
err -> String -> Parser AnyValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AnyValue) -> String -> Parser AnyValue
forall a b. (a -> b) -> a -> b
$ TypeMismatchError -> String
forall a. Show a => a -> String
show TypeMismatchError
err
    Right v :: AnyValue
v  -> AnyValue -> Parser AnyValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnyValue
v