{- |
Copyright: (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

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 (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 = 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 hexadecimal, octal and binary numbers : included parsing
numberP :: Parser Integer -> Parser Char -> String -> Parser Integer
numberP :: Parser Integer
-> ParsecT Void Text Identity Char -> String -> Parser Integer
numberP parseInteger :: Parser Integer
parseInteger parseDigit :: ParsecT Void Text Identity Char
parseDigit errorMessage :: String
errorMessage = Parser Integer
more
  where
    more :: Parser Integer
    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
intValueMaybe (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
parseDigit) (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
'_')

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

    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 String
errorMessage) 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
binaryP      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
octalP       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
hexadecimalP 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"
    binaryP :: Parser Integer
binaryP = Parser Integer
-> ParsecT Void Text Identity Char -> String -> Parser Integer
numberP Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
binDigitChar "Invalid binary number"
    octalP :: Parser Integer
octalP  = Parser Integer
-> ParsecT Void Text Identity Char -> String -> Parser Integer
numberP Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
octal ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
octDigitChar  "Invalid ocatl number"
    hexadecimalP :: Parser Integer
hexadecimalP = Parser Integer
-> ParsecT Void Text Identity Char -> String -> Parser Integer
numberP Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar "Invalid hexadecimal number"

-- | 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