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)
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
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"
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"
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
]
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"
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 :: 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)
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
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
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
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
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
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'
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
UValue
v <- Parser UValue
valueP
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
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
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