{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Text.Enum.Text
( EnumText(..)
, UsingEnumText(..)
, TextParsable(..)
, EnumTextConfig(..)
, defaultEnumTextConfig
) where
import Control.Monad (void)
import Control.Monad.Fail as CMF
import Data.Array
import qualified Data.Attoparsec.Text as AP
import qualified Data.ByteString.Char8 as B
import Data.Coerce
import Data.Hashable
import Data.Possibly
import Data.Scientific (toBoundedInteger)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Read
import Data.Time
import Fmt
import Text.Read
class ( Buildable e
, Bounded e
, Enum e
, Eq e
, Ord e
, Show e
, TextParsable e
) => EnumText e where
configEnumText :: e -> EnumTextConfig
configEnumText e
_ = EnumTextConfig
defaultEnumTextConfig
renderEnumText :: e -> T.Text
renderEnumText e
e = Array (I e) Text
forall e. EnumText e => Array (I e) Text
enumTextArray Array (I e) Text -> I e -> Text
forall i e. Ix i => Array i e -> i -> e
! e -> I e
forall a. a -> I a
I e
e
buildEnumText :: e -> Builder
buildEnumText = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> (e -> Text) -> e -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Text
forall e. EnumText e => e -> Text
renderEnumText
parseEnumText :: T.Text -> Possibly e
parseEnumText Text
txt = Possibly e -> (e -> Possibly e) -> Maybe e -> Possibly e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Possibly e
forall a b. a -> Either a b
Left [Char]
msg) e -> Possibly e
forall a b. b -> Either a b
Right (Maybe e -> Possibly e) -> Maybe e -> Possibly e
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text e -> Maybe e
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
txt HashMap Text e
forall e. EnumText e => HashMap Text e
hashmap_t
where
msg :: [Char]
msg = [Char]
"parseEnumText: enumeration not recognised: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Text -> [Char]
forall a. Show a => a -> [Char]
show Text
txt
toFieldEnumText :: e -> B.ByteString
toFieldEnumText e
e = Array (I e) ByteString
forall e. EnumText e => Array (I e) ByteString
enumByteStringArray Array (I e) ByteString -> I e -> ByteString
forall i e. Ix i => Array i e -> i -> e
! e -> I e
forall a. a -> I a
I e
e
fromFieldEnumText_ :: MonadFail m => B.ByteString -> m e
fromFieldEnumText_ ByteString
bs = m e -> (e -> m e) -> Maybe e -> m e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m e
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
CMF.fail [Char]
msg) e -> m e
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe e -> m e) -> Maybe e -> m e
forall a b. (a -> b) -> a -> b
$ ByteString -> HashMap ByteString e -> Maybe e
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
bs HashMap ByteString e
forall e. EnumText e => HashMap ByteString e
hashmap_b
where
msg :: [Char]
msg = [Char]
"fromFieldEnumText_: enumeration not recognised: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs
hashWithSaltEnumText :: Int -> e -> Int
hashWithSaltEnumText Int
n = Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (ByteString -> Int) -> (e -> ByteString) -> e -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ByteString
forall e. EnumText e => e -> ByteString
toFieldEnumText
newtype UsingEnumText a = UsingEnumText { UsingEnumText a -> a
_UsingEnumText :: a }
instance EnumText a => Buildable (UsingEnumText a) where
build :: UsingEnumText a -> Builder
build (UsingEnumText a
x) = a -> Builder
forall e. EnumText e => e -> Builder
buildEnumText a
x
instance EnumText a => TextParsable (UsingEnumText a) where
parseText :: Text -> Possibly (UsingEnumText a)
parseText Text
x = a -> UsingEnumText a
forall a. a -> UsingEnumText a
UsingEnumText (a -> UsingEnumText a)
-> Either [Char] a -> Possibly (UsingEnumText a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] a
forall e. EnumText e => Text -> Possibly e
parseEnumText Text
x
data EnumTextConfig =
EnumTextConfig
{ EnumTextConfig -> Text -> Text
_etc_text_prep :: T.Text -> T.Text
, EnumTextConfig -> Char -> Char
_etc_char_prep :: Char -> Char
}
defaultEnumTextConfig :: EnumTextConfig
defaultEnumTextConfig :: EnumTextConfig
defaultEnumTextConfig =
EnumTextConfig :: (Text -> Text) -> (Char -> Char) -> EnumTextConfig
EnumTextConfig
{ _etc_text_prep :: Text -> Text
_etc_text_prep = Text -> Text
defaultTextPrep
, _etc_char_prep :: Char -> Char
_etc_char_prep = Char -> Char
defaultCharPrep
}
defaultTextPrep :: T.Text -> T.Text
defaultTextPrep :: Text -> Text
defaultTextPrep Text
txt = case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'_') Text
txt of
Just (Char
_,Text
rst) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
rst -> Text
rst
Maybe (Char, Text)
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"defaultTextPrep: bad data constructor: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
txt
defaultCharPrep :: Char -> Char
defaultCharPrep :: Char -> Char
defaultCharPrep Char
c = case Char
c of
Char
'_' -> Char
'-'
Char
_ -> Char
c
class TextParsable a where
parseText :: T.Text -> Possibly a
instance TextParsable T.Text where parseText :: Text -> Possibly Text
parseText = Text -> Possibly Text
forall (m :: * -> *) a. Monad m => a -> m a
return
instance TextParsable UTCTime where parseText :: Text -> Possibly UTCTime
parseText = (Text -> Maybe UTCTime) -> [Char] -> Text -> Possibly UTCTime
forall a. (Text -> Maybe a) -> [Char] -> Text -> Possibly a
parseTextUsing Text -> Maybe UTCTime
parseUTC [Char]
"UTCTime"
instance TextParsable Day where parseText :: Text -> Possibly Day
parseText = [Char] -> Text -> Possibly Day
forall a. Read a => [Char] -> Text -> Possibly a
parseTextRead [Char]
"Day"
instance TextParsable Int where parseText :: Text -> Possibly Int
parseText = Text -> Possibly Int
parseDecimal
instance a ~ Char => TextParsable [a] where parseText :: Text -> Possibly [a]
parseText = [Char] -> Either [Char] [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either [Char] [Char])
-> (Text -> [Char]) -> Text -> Either [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
instance TextParsable a => TextParsable (Maybe a) where
parseText :: Text -> Possibly (Maybe a)
parseText = \case
Text
"" -> Maybe a -> Possibly (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
Text
s -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either [Char] a -> Possibly (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either [Char] a
forall a. TextParsable a => Text -> Possibly a
parseText Text
s
newtype I a = I { I a -> a
_I :: a }
deriving (I a -> I a -> Bool
(I a -> I a -> Bool) -> (I a -> I a -> Bool) -> Eq (I a)
forall a. Eq a => I a -> I a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: I a -> I a -> Bool
$c/= :: forall a. Eq a => I a -> I a -> Bool
== :: I a -> I a -> Bool
$c== :: forall a. Eq a => I a -> I a -> Bool
Eq,Eq (I a)
Eq (I a)
-> (I a -> I a -> Ordering)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> Bool)
-> (I a -> I a -> I a)
-> (I a -> I a -> I a)
-> Ord (I a)
I a -> I a -> Bool
I a -> I a -> Ordering
I a -> I a -> I a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (I a)
forall a. Ord a => I a -> I a -> Bool
forall a. Ord a => I a -> I a -> Ordering
forall a. Ord a => I a -> I a -> I a
min :: I a -> I a -> I a
$cmin :: forall a. Ord a => I a -> I a -> I a
max :: I a -> I a -> I a
$cmax :: forall a. Ord a => I a -> I a -> I a
>= :: I a -> I a -> Bool
$c>= :: forall a. Ord a => I a -> I a -> Bool
> :: I a -> I a -> Bool
$c> :: forall a. Ord a => I a -> I a -> Bool
<= :: I a -> I a -> Bool
$c<= :: forall a. Ord a => I a -> I a -> Bool
< :: I a -> I a -> Bool
$c< :: forall a. Ord a => I a -> I a -> Bool
compare :: I a -> I a -> Ordering
$ccompare :: forall a. Ord a => I a -> I a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (I a)
Ord)
instance EnumText e => Ix (I e) where
range :: (I e, I e) -> [I e]
range (I e
l,I e
h) = [e] -> [I e]
coerce [I e -> e
forall a. I a -> a
_I I e
l..I e -> e
forall a. I a -> a
_I I e
h]
index :: (I e, I e) -> I e -> Int
index (I e
l,I e
_) I e
x = e -> Int
forall a. Enum a => a -> Int
fromEnum (I e -> e
forall a. I a -> a
_I I e
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
- e -> Int
forall a. Enum a => a -> Int
fromEnum (I e -> e
forall a. I a -> a
_I I e
l)
inRange :: (I e, I e) -> I e -> Bool
inRange (I e
l,I e
h) I e
x = I e -> e
forall a. I a -> a
_I I e
l e -> e -> Bool
forall a. Ord a => a -> a -> Bool
<= I e -> e
forall a. I a -> a
_I I e
x Bool -> Bool -> Bool
&& I e -> e
forall a. I a -> a
_I I e
x e -> e -> Bool
forall a. Ord a => a -> a -> Bool
<= I e -> e
forall a. I a -> a
_I I e
h
enumTextArray :: forall e . EnumText e => Array (I e) T.Text
enumTextArray :: Array (I e) Text
enumTextArray =
(I e, I e) -> [Text] -> Array (I e) Text
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (e -> I e
forall a. a -> I a
I e
forall a. Bounded a => a
minBound,e -> I e
forall a. a -> I a
I e
forall a. Bounded a => a
maxBound)
[ (Char -> Char) -> Text -> Text
T.map Char -> Char
_etc_char_prep (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
_etc_text_prep (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ e -> [Char]
forall a. Show a => a -> [Char]
show e
e
| e
e <- [e
forall a. Bounded a => a
minBound..e
forall a. Bounded a => a
maxBound :: e]
]
where
EnumTextConfig{Char -> Char
Text -> Text
_etc_text_prep :: Text -> Text
_etc_char_prep :: Char -> Char
_etc_char_prep :: EnumTextConfig -> Char -> Char
_etc_text_prep :: EnumTextConfig -> Text -> Text
..} = e -> EnumTextConfig
forall e. EnumText e => e -> EnumTextConfig
configEnumText (e
forall a. Bounded a => a
minBound :: e)
enumByteStringArray :: forall e . EnumText e => Array (I e) B.ByteString
enumByteStringArray :: Array (I e) ByteString
enumByteStringArray = (I e, I e) -> [ByteString] -> Array (I e) ByteString
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (e -> I e
forall a. a -> I a
I e
forall a. Bounded a => a
minBound,e -> I e
forall a. a -> I a
I e
forall a. Bounded a => a
maxBound)
[ Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ e -> Text
forall e. EnumText e => e -> Text
renderEnumText e
e
| e
e <- [e
forall a. Bounded a => a
minBound..e
forall a. Bounded a => a
maxBound :: e]
]
hashmap_t :: EnumText e => HM.HashMap T.Text e
hashmap_t :: HashMap Text e
hashmap_t = [(Text, e)] -> HashMap Text e
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
[ (e -> Text
forall e. EnumText e => e -> Text
renderEnumText e
c,e
c)
| e
c <- [e
forall a. Bounded a => a
minBound..e
forall a. Bounded a => a
maxBound]
]
hashmap_b :: EnumText e => HM.HashMap B.ByteString e
hashmap_b :: HashMap ByteString e
hashmap_b = [(ByteString, e)] -> HashMap ByteString e
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
[ (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ e -> Text
forall e. EnumText e => e -> Text
renderEnumText e
c,e
c)
| e
c <- [e
forall a. Bounded a => a
minBound..e
forall a. Bounded a => a
maxBound]
]
parseDecimal :: T.Text -> Possibly Int
parseDecimal :: Text -> Possibly Int
parseDecimal Text
txt = ([Char] -> Possibly Int)
-> (Int -> Possibly Int) -> Possibly Int -> Possibly Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Possibly Int
forall a b. a -> Either a b
Left ([Char] -> Possibly Int)
-> ([Char] -> [Char]) -> [Char] -> Possibly Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
typeError [Char]
"integer") Int -> Possibly Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Possibly Int -> Possibly Int) -> Possibly Int -> Possibly Int
forall a b. (a -> b) -> a -> b
$ do
(Int
x,Text
r) <- Reader Int -> Reader Int
forall a. Num a => Reader a -> Reader a
signed Reader Int
forall a. Integral a => Reader a
decimal Text
txt
case Text -> Bool
T.null Text
r of
Bool
True -> Int -> Possibly Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
Bool
False -> [Char] -> Possibly Int
forall a b. a -> Either a b
Left ([Char] -> Possibly Int) -> [Char] -> Possibly Int
forall a b. (a -> b) -> a -> b
$ [Char]
"residual input: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
r
parseTextRead :: Read a
=> String
-> T.Text
-> Possibly a
parseTextRead :: [Char] -> Text -> Possibly a
parseTextRead = (Text -> Maybe a) -> [Char] -> Text -> Possibly a
forall a. (Text -> Maybe a) -> [Char] -> Text -> Possibly a
parseTextUsing ([Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe a) -> (Text -> [Char]) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack)
parseTextUsing :: (T.Text -> Maybe a)
-> String
-> T.Text
-> Possibly a
parseTextUsing :: (Text -> Maybe a) -> [Char] -> Text -> Possibly a
parseTextUsing Text -> Maybe a
maybeParser [Char]
ty_s Text
txt =
Possibly a -> (a -> Possibly a) -> Maybe a -> Possibly a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Possibly a
forall a b. a -> Either a b
Left ([Char] -> Possibly a) -> [Char] -> Possibly a
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
typeError [Char]
ty_s ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
str) a -> Possibly a
forall a b. b -> Either a b
Right (Maybe a -> Possibly a) -> Maybe a -> Possibly a
forall a b. (a -> b) -> a -> b
$ Text -> Maybe a
maybeParser Text
txt
where
str :: [Char]
str = Text -> [Char]
T.unpack Text
txt
typeError :: String -> String -> String
typeError :: [Char] -> [Char] -> [Char]
typeError [Char]
ty_s [Char]
msg = [Char]
"failed to parse "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
ty_s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
": "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
msg
parseUTC :: T.Text -> Maybe UTCTime
parseUTC :: Text -> Maybe UTCTime
parseUTC Text
t = case Parser UTCTime -> Text -> Possibly UTCTime
forall a. Parser a -> Text -> Either [Char] a
AP.parseOnly (Parser UTCTime
parserUTCTime Parser UTCTime -> Parser Text () -> Parser UTCTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AP.endOfInput) Text
t of
Left [Char]
_ -> Maybe UTCTime
forall a. Maybe a
Nothing
Right UTCTime
r -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
r
parserUTCTime :: AP.Parser UTCTime
parserUTCTime :: Parser UTCTime
parserUTCTime = do
Day
day <- Parser Day
parserDay
Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text ()
AP.skip (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T')
DiffTime
time <- Parser DiffTime
parserTime
Maybe NominalDiffTime
mb_offset <- Parser (Maybe NominalDiffTime)
parserTimeZone
UTCTime -> Parser UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((UTCTime -> UTCTime)
-> (NominalDiffTime -> UTCTime -> UTCTime)
-> Maybe NominalDiffTime
-> UTCTime
-> UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTCTime -> UTCTime
forall a. a -> a
id NominalDiffTime -> UTCTime -> UTCTime
addUTCTime Maybe NominalDiffTime
mb_offset (UTCTime -> UTCTime) -> UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
time)
parserDay :: AP.Parser Day
parserDay :: Parser Day
parserDay = do
Int
y :: Int <- Parser Int
forall a. Integral a => Parser a
AP.decimal Parser Int -> Parser Text Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
AP.char Char
'-'
Int
m :: Int <- Parser Int
forall a. Integral a => Parser a
AP.decimal Parser Int -> Parser Text Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
AP.char Char
'-'
Int
d :: Int <- Parser Int
forall a. Integral a => Parser a
AP.decimal
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int
m Int
d of
Just Day
x -> Day -> Parser Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
x
Maybe Day
Nothing -> [Char] -> Parser Day
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"invalid date"
parserTime :: AP.Parser DiffTime
parserTime :: Parser DiffTime
parserTime = do
Int
h :: Int <- Parser Int
forall a. Integral a => Parser a
AP.decimal
Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser Text ())
-> Parser Text Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
AP.char Char
':'
Int
m :: Int <- Parser Int
forall a. Integral a => Parser a
AP.decimal
Maybe Char
c <- Parser (Maybe Char)
AP.peekChar
Scientific
s <- case Maybe Char
c of
Just Char
':' -> Parser Text Char
AP.anyChar Parser Text Char
-> Parser Text Scientific -> Parser Text Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Scientific
AP.scientific
Maybe Char
_ -> Scientific -> Parser Text Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
0
case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger (Scientific
10Scientific -> Int -> Scientific
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
12::Int) Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
* (Scientific
s Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h)))) of
Just Int
n -> DiffTime -> Parser DiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> DiffTime
picosecondsToDiffTime (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n :: Int)))
Maybe Int
Nothing -> [Char] -> Parser DiffTime
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"seconds out of range"
parserTimeZone :: AP.Parser (Maybe NominalDiffTime)
parserTimeZone :: Parser (Maybe NominalDiffTime)
parserTimeZone = do
Char
c <- Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option Char
'Z' Parser Text Char
AP.anyChar
case Char
c of
Char
'Z' -> Maybe NominalDiffTime -> Parser (Maybe NominalDiffTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NominalDiffTime
forall a. Maybe a
Nothing
Char
' ' -> Parser Text Text
"UTC" Parser Text Text
-> Parser (Maybe NominalDiffTime) -> Parser (Maybe NominalDiffTime)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe NominalDiffTime -> Parser (Maybe NominalDiffTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NominalDiffTime
forall a. Maybe a
Nothing
Char
'+' -> Bool -> Parser (Maybe NominalDiffTime)
forall a. Num a => Bool -> Parser Text (Maybe a)
parse_offset Bool
True
Char
'-' -> Bool -> Parser (Maybe NominalDiffTime)
forall a. Num a => Bool -> Parser Text (Maybe a)
parse_offset Bool
False
Char
_ -> [Char] -> Parser (Maybe NominalDiffTime)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unexpected time zone character"
where
parse_offset :: Bool -> Parser Text (Maybe a)
parse_offset Bool
pos = do
Int
hh :: Int <- [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser Text [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
AP.count Int
2 Parser Text Char
AP.digit
() -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option () ((Char -> Bool) -> Parser Text ()
AP.skip (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'))
Int
mm :: Int <- Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
AP.option Int
0 ([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> Parser Text [Char] -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
AP.count Int
2 Parser Text Char
AP.digit)
let v :: Int
v = (if Bool
pos then Int -> Int
forall a. Num a => a -> a
negate else Int -> Int
forall a. a -> a
id) ((Int
hhInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mm) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60)
Maybe a -> Parser Text (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v))