{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Attoparsec.Time.Text
( timeOfDayInISO8601,
timeOfDayInDashes,
dayInISO8601,
yearAndMonthInISO8601,
timeZoneInISO8601,
utcTimeInISO8601,
utcTimeInDashes,
diffTime,
nominalDiffTime,
hour,
minute,
second,
)
where
import Attoparsec.Time.Prelude hiding (take, takeWhile)
import qualified Attoparsec.Time.Pure as A
import qualified Attoparsec.Time.Validation as B
import Data.Attoparsec.Text
import qualified Data.Text as C
validated :: (Show a) => B.Validator a -> Parser a -> Parser a
validated :: forall a. Show a => Validator a -> Parser a -> Parser a
validated Validator a
validator Parser a
parser =
Parser a
parser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> forall a b. Show a => Validator a -> b -> (String -> b) -> a -> b
B.run Validator a
validator (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) forall (m :: * -> *) a. MonadFail m => String -> m a
fail a
x
sign :: Parser Bool
sign :: Parser Bool
sign =
Parser Char
anyChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'+' -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Char
'-' -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Char
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
decimalChar :: Parser Int
decimalChar :: Parser Int
decimalChar =
forall a. (Char -> a) -> (a -> Bool) -> Parser a
satisfyWith ((forall a. Num a => a -> a -> a
subtract Int
48) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord) (Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Ord a => a -> a -> Bool
>= Int
0) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Ord a => a -> a -> Bool
<= Int
9))
decimalOfLength :: (Num a) => Int -> Parser a
decimalOfLength :: forall a. Num a => Int -> Parser a
decimalOfLength Int
length =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
a a
b -> a
a forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ a
b) a
0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
length (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Parser Int
decimalChar)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid decimal length"
shortMonth :: Parser Int
shortMonth :: Parser Int
shortMonth =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Text
C.toLower (Int -> Parser Text
take Int
3) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Text
"jan" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
Text
"feb" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Text
"mar" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
Text
"apr" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
Text
"may" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
5
Text
"jun" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
6
Text
"jul" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
7
Text
"aug" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
Text
"sep" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
Text
"oct" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
Text
"nov" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
11
Text
"dec" -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
12
Text
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength Int
basisLength =
(\[Int]
a [Int]
b -> forall k (a :: k). Integer -> Fixed a
MkFixed (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Integer
a Int
b -> Integer
a forall a. Num a => a -> a -> a
* Integer
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b) Integer
0 ([Int]
a forall a. [a] -> [a] -> [a]
++ [Int]
b))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Int]
beforePoint forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Int]
afterPoint
where
resolution :: a
resolution =
a
12
beforePoint :: Parser Text [Int]
beforePoint =
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
basisLength Parser Int
decimalChar
afterPoint :: Parser Text [Int]
afterPoint =
forall {a}. a -> [a] -> Int -> [a] -> [a]
padListFromRight Int
0 [] forall {a}. Num a => a
resolution forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Parser Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Int
decimalChar) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where
padListFromRight :: a -> [a] -> Int -> [a] -> [a]
padListFromRight a
padding [a]
accumulator Int
length [a]
list =
case Int
length of
Int
0 -> forall a. [a] -> [a]
reverse [a]
accumulator
Int
_ -> case [a]
list of
a
head : [a]
tail -> a -> [a] -> Int -> [a] -> [a]
padListFromRight a
padding (a
head forall a. a -> [a] -> [a]
: [a]
accumulator) (forall a. Enum a => a -> a
pred Int
length) [a]
tail
[a]
_ -> forall a. [a] -> [a]
reverse [a]
accumulator forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
length a
padding
{-# INLINE hour #-}
hour :: Parser Int
hour :: Parser Int
hour =
forall a. Show a => Validator a -> Parser a -> Parser a
validated forall a. (Num a, Ord a) => Validator a
B.hour (forall a. Num a => Int -> Parser a
decimalOfLength Int
2) forall i a. Parser i a -> String -> Parser i a
<?> String
"hour"
{-# INLINE minute #-}
minute :: Parser Int
minute :: Parser Int
minute =
forall a. Show a => Validator a -> Parser a -> Parser a
validated forall a. (Num a, Ord a) => Validator a
B.minute (forall a. Num a => Int -> Parser a
decimalOfLength Int
2) forall i a. Parser i a -> String -> Parser i a
<?> String
"minute"
{-# INLINE second #-}
second :: Parser Pico
second :: Parser Pico
second =
forall a. Show a => Validator a -> Parser a -> Parser a
validated forall a. (Num a, Ord a) => Validator a
B.second (Int -> Parser Pico
picoWithBasisOfLength Int
2) forall i a. Parser i a -> String -> Parser i a
<?> String
"second"
{-# INLINE timeOfDayInISO8601 #-}
timeOfDayInISO8601 :: Parser TimeOfDay
timeOfDayInISO8601 :: Parser TimeOfDay
timeOfDayInISO8601 =
Parser TimeOfDay
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"timeOfDayInISO8601"
where
unnamedParser :: Parser TimeOfDay
unnamedParser =
Int -> Int -> Pico -> TimeOfDay
A.timeOfDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Int
hour forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
':')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Int
minute forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
':')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Pico
second)
{-# INLINE timeOfDayInDashes #-}
timeOfDayInDashes :: Parser TimeOfDay
timeOfDayInDashes :: Parser TimeOfDay
timeOfDayInDashes =
Parser TimeOfDay
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"timeOfDayInDashes"
where
unnamedParser :: Parser TimeOfDay
unnamedParser =
Int -> Int -> Pico -> TimeOfDay
A.timeOfDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Int
hour forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'-')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Int
minute forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'-')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Pico
second)
{-# INLINE dayInISO8601 #-}
dayInISO8601 :: Parser Day
dayInISO8601 :: Parser Day
dayInISO8601 =
Parser Day
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"dayInISO8601"
where
unnamedParser :: Parser Day
unnamedParser =
do
Integer
year <- forall a. Num a => Int -> Parser a
decimalOfLength Int
4
Char -> Parser Char
char Char
'-'
Int
month <- forall a. Num a => Int -> Parser a
decimalOfLength Int
2
Char -> Parser Char
char Char
'-'
Int
day <- forall a. Num a => Int -> Parser a
decimalOfLength Int
2
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
Just Day
day -> forall (m :: * -> *) a. Monad m => a -> m a
return Day
day
Maybe Day
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall {a} {b} {c}.
(Show a, Show b, Show c) =>
a -> b -> c -> String
error Integer
year Int
month Int
day)
where
error :: a -> b -> c -> String
error a
year b
month c
day =
String -> ShowS
showString String
"Invalid combination of year month and day: "
forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (a
year, b
month, c
day)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 =
forall {a} {b}. (Num a, Num b) => Parser Text (a, b)
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"yearAndMonthInISO8601"
where
unnamedParser :: Parser Text (a, b)
unnamedParser =
do
a
year <- forall a. Num a => Int -> Parser a
decimalOfLength Int
4
Char -> Parser Char
char Char
'-'
b
month <- forall a. Num a => Int -> Parser a
decimalOfLength Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return (a
year, b
month)
timeZoneInISO8601 :: Parser TimeZone
timeZoneInISO8601 :: Parser TimeZone
timeZoneInISO8601 =
Parser TimeZone
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"timeZoneInISO8601"
where
unnamedParser :: Parser TimeZone
unnamedParser =
Parser TimeZone
z forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeZone
offset
where
z :: Parser TimeZone
z =
Char -> Parser Char
char Char
'Z' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TimeZone
utc
offset :: Parser TimeZone
offset =
Bool -> Int -> Int -> TimeZone
A.timeZone forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
sign forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Num a => Int -> Parser a
decimalOfLength Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Num a => Int -> Parser a
decimalOfLength Int
2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Num a => Int -> Parser a
decimalOfLength Int
2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0)
utcTimeInISO8601 :: Parser UTCTime
utcTimeInISO8601 :: Parser UTCTime
utcTimeInISO8601 =
Parser UTCTime
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"utcTimeInISO8601"
where
unnamedParser :: Parser UTCTime
unnamedParser =
do
Day
day <- Parser Day
dayInISO8601
Char -> Parser Char
char Char
'T'
TimeOfDay
time <- Parser TimeOfDay
timeOfDayInISO8601
TimeZone
zone <- Parser TimeZone
timeZoneInISO8601
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> TimeOfDay -> TimeZone -> UTCTime
A.utcTimeFromDayAndTimeOfDay Day
day TimeOfDay
time TimeZone
zone)
utcTimeInDashes :: Parser UTCTime
utcTimeInDashes :: Parser UTCTime
utcTimeInDashes =
Parser UTCTime
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"utcTimeInDashes"
where
unnamedParser :: Parser UTCTime
unnamedParser =
do
Day
day <- Parser Day
dayInISO8601
Char -> Parser Char
char Char
'-'
TimeOfDay
time <- Parser TimeOfDay
timeOfDayInDashes
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time))
diffTime :: Parser DiffTime
diffTime :: Parser DiffTime
diffTime =
forall {b}. Fractional b => Parser Text b
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"diffTime"
where
unnamedParser :: Parser Text b
unnamedParser =
do
Scientific
amount <- Parser Scientific
scientific
b -> b
factor <- forall a. Fractional a => Parser (a -> a)
timeUnitFactor
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
factor (forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
amount))
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime =
forall {b}. Fractional b => Parser Text b
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"nominalDiffTime"
where
unnamedParser :: Parser Text b
unnamedParser =
do
Scientific
amount <- Parser Scientific
scientific
b -> b
factor <- forall a. Fractional a => Parser (a -> a)
timeUnitFactor
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
factor (forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
amount))
timeUnitFactor :: (Fractional a) => Parser (a -> a)
timeUnitFactor :: forall a. Fractional a => Parser (a -> a)
timeUnitFactor =
(Char -> Bool) -> Parser Text
takeWhile Char -> Bool
isAlpha forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Text
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
Text
"s" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
Text
"ms" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000)
Text
"μs" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000)
Text
"us" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000)
Text
"ns" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000000)
Text
"ps" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000000000)
Text
"m" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
60)
Text
"h" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
3600)
Text
"d" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
86400)
Text
unit -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported unit: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
unit)