module Attoparsec.Time.ByteString
(
timeOfDayInISO8601,
dayInISO8601,
yearAndMonthInISO8601,
timeZoneInISO8601,
utcTimeInISO8601,
diffTime,
nominalDiffTime,
)
where
import Attoparsec.Time.Prelude hiding (take, takeWhile)
import Data.Attoparsec.ByteString
import qualified Attoparsec.Time.Pure as A
import qualified Attoparsec.Time.Validation as B
import qualified Data.ByteString as C
import qualified Data.Attoparsec.ByteString.Char8 as D
validated :: Show a => B.Validator a -> Parser a -> Parser a
validated :: Validator a -> Parser a -> Parser a
validated Validator a
validator Parser a
parser =
Parser a
parser Parser a -> (a -> Parser a) -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Validator a -> Parser a -> (String -> Parser a) -> a -> Parser a
forall a b. Show a => Validator a -> b -> (String -> b) -> a -> b
B.run Validator a
validator (a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a
x
sign :: Parser Bool
sign :: Parser Bool
sign =
Parser Word8
anyWord8 Parser Word8 -> (Word8 -> Parser Bool) -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
43 -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Word8
45 -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Word8
_ -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a
empty
decimalOfLength :: Integral a => Int -> Parser a
decimalOfLength :: Int -> Parser a
decimalOfLength Int
length =
do
ByteString
bytes <- Int -> Parser ByteString
take Int
length
if (Word8 -> Bool) -> ByteString -> Bool
C.all Word8 -> Bool
A.word8IsAsciiDigit ByteString
bytes
then a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> a
forall decimal. Integral decimal => ByteString -> decimal
A.decimalFromBytes ByteString
bytes)
else String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not all chars are valid decimals"
picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength Int
basisLength =
Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Pico) -> Parser ByteString Integer -> Parser Pico
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) (Integer -> Integer -> Integer)
-> Parser ByteString Integer
-> Parser ByteString (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer
beforePoint Parser ByteString (Integer -> Integer)
-> Parser ByteString Integer -> Parser ByteString Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Word8 -> Parser Word8
word8 Word8
46 Parser Word8
-> Parser ByteString Integer -> Parser ByteString Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Integer
forall b. Integral b => Parser ByteString b
afterPoint) Parser ByteString Integer
-> Parser ByteString Integer -> Parser ByteString Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Parser ByteString Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0))
where
beforePoint :: Parser ByteString Integer
beforePoint =
(Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12)) (Integer -> Integer)
-> Parser ByteString Integer -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString Integer
forall a. Integral a => Int -> Parser a
decimalOfLength Int
basisLength
afterPoint :: Parser ByteString b
afterPoint =
(ByteString -> b) -> Parser ByteString -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> b
forall decimal. Integral decimal => ByteString -> decimal
updater (ByteString -> b) -> (ByteString -> ByteString) -> ByteString -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> ByteString -> ByteString
C.take Int
12) ((Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
A.word8IsAsciiDigit)
where
updater :: ByteString -> p
updater ByteString
bytes =
let
afterPoint :: p
afterPoint =
ByteString -> p
forall decimal. Integral decimal => ByteString -> decimal
A.decimalFromBytes ByteString
bytes
afterPointLength :: Int
afterPointLength =
ByteString -> Int
C.length ByteString
bytes
paddedAfterPoint :: p
paddedAfterPoint =
if Int
afterPointLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12
then p
afterPoint p -> p -> p
forall a. Num a => a -> a -> a
* (p
10 p -> Int -> p
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
afterPointLength))
else p
afterPoint
in p
paddedAfterPoint
{-# INLINE hour #-}
hour :: Parser Int
hour :: Parser Int
hour =
Validator Int -> Parser Int -> Parser Int
forall a. Show a => Validator a -> Parser a -> Parser a
validated Validator Int
forall a. (Num a, Ord a) => Validator a
B.hour (Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2) Parser Int -> String -> Parser Int
forall i a. Parser i a -> String -> Parser i a
<?> String
"hour"
{-# INLINE minute #-}
minute :: Parser Int
minute :: Parser Int
minute =
Validator Int -> Parser Int -> Parser Int
forall a. Show a => Validator a -> Parser a -> Parser a
validated Validator Int
forall a. (Num a, Ord a) => Validator a
B.minute (Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2) Parser Int -> String -> Parser Int
forall i a. Parser i a -> String -> Parser i a
<?> String
"minute"
{-# INLINE second #-}
second :: Parser Pico
second :: Parser Pico
second =
Validator Pico -> Parser Pico -> Parser Pico
forall a. Show a => Validator a -> Parser a -> Parser a
validated Validator Pico
forall a. (Num a, Ord a) => Validator a
B.second (Int -> Parser Pico
picoWithBasisOfLength Int
2) Parser Pico -> String -> Parser Pico
forall i a. Parser i a -> String -> Parser i a
<?> String
"second"
{-# INLINE timeOfDayInISO8601 #-}
timeOfDayInISO8601 :: Parser TimeOfDay
timeOfDayInISO8601 :: Parser TimeOfDay
timeOfDayInISO8601 =
Parser TimeOfDay
unnamedParser Parser TimeOfDay -> String -> Parser TimeOfDay
forall i a. Parser i a -> String -> Parser i a
<?> String
"timeOfDayInISO8601"
where
unnamedParser :: Parser TimeOfDay
unnamedParser =
Int -> Int -> Pico -> TimeOfDay
A.timeOfDay (Int -> Int -> Pico -> TimeOfDay)
-> Parser Int -> Parser ByteString (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Parser Int
hour Parser Int -> Parser Word8 -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
58) Parser ByteString (Int -> Pico -> TimeOfDay)
-> Parser Int -> Parser ByteString (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
(Parser Int
minute Parser Int -> Parser Word8 -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
58) Parser ByteString (Pico -> TimeOfDay)
-> Parser Pico -> Parser TimeOfDay
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 Parser Day -> String -> Parser Day
forall i a. Parser i a -> String -> Parser i a
<?> String
"dayInISO8601"
where
unnamedParser :: Parser Day
unnamedParser =
do
Integer
year <- Int -> Parser ByteString Integer
forall a. Integral a => Int -> Parser a
decimalOfLength Int
4
Word8 -> Parser Word8
word8 Word8
45
Int
month <- Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2
Word8 -> Parser Word8
word8 Word8
45
Int
day <- Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
Just Day
day -> Day -> Parser Day
forall (m :: * -> *) a. Monad m => a -> m a
return Day
day
Maybe Day
Nothing -> String -> Parser Day
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Integer -> Int -> Int -> String
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: " ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
(a, b, c) -> String
forall a. Show a => a -> String
show (a
year, b
month, c
day)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 =
Parser (Word, Word)
forall a b. (Integral a, Integral b) => Parser ByteString (a, b)
unnamedParser Parser (Word, Word) -> String -> Parser (Word, Word)
forall i a. Parser i a -> String -> Parser i a
<?> String
"yearAndMonthInISO8601"
where
unnamedParser :: Parser ByteString (a, b)
unnamedParser =
do
a
year <- Int -> Parser a
forall a. Integral a => Int -> Parser a
decimalOfLength Int
4
Word8 -> Parser Word8
word8 Word8
45
b
month <- Int -> Parser b
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2
(a, b) -> Parser ByteString (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
year, b
month)
timeZoneInISO8601 :: Parser TimeZone
timeZoneInISO8601 :: Parser TimeZone
timeZoneInISO8601 =
Parser TimeZone
unnamedParser Parser TimeZone -> String -> Parser TimeZone
forall i a. Parser i a -> String -> Parser i a
<?> String
"timeZoneInISO8601"
where
unnamedParser :: Parser TimeZone
unnamedParser =
Parser TimeZone
z Parser TimeZone -> Parser TimeZone -> Parser TimeZone
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TimeZone
offset
where
z :: Parser TimeZone
z =
Word8 -> Parser Word8
word8 Word8
90 Parser Word8 -> TimeZone -> Parser TimeZone
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TimeZone
utc
offset :: Parser TimeZone
offset =
Bool -> Int -> Int -> TimeZone
A.timeZone (Bool -> Int -> Int -> TimeZone)
-> Parser Bool -> Parser ByteString (Int -> Int -> TimeZone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
sign Parser ByteString (Int -> Int -> TimeZone)
-> Parser Int -> Parser ByteString (Int -> TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2 Parser ByteString (Int -> TimeZone)
-> Parser Int -> Parser TimeZone
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Parser Word8
word8 Word8
58 Parser Word8 -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2 Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall a. Integral a => Int -> Parser a
decimalOfLength Int
2 Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0)
utcTimeInISO8601 :: Parser UTCTime
utcTimeInISO8601 :: Parser UTCTime
utcTimeInISO8601 =
Parser UTCTime
unnamedParser Parser UTCTime -> String -> Parser UTCTime
forall i a. Parser i a -> String -> Parser i a
<?> String
"utcTimeInISO8601"
where
unnamedParser :: Parser UTCTime
unnamedParser =
do
Day
day <- Parser Day
dayInISO8601
Word8 -> Parser Word8
word8 Word8
84
TimeOfDay
time <- Parser TimeOfDay
timeOfDayInISO8601
TimeZone
zone <- Parser TimeZone
timeZoneInISO8601
UTCTime -> Parser UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> TimeOfDay -> TimeZone -> UTCTime
A.utcTimeFromDayAndTimeOfDay Day
day TimeOfDay
time TimeZone
zone)
diffTime :: Parser DiffTime
diffTime :: Parser DiffTime
diffTime =
Parser DiffTime
forall b. Fractional b => Parser ByteString b
unnamedParser Parser DiffTime -> String -> Parser DiffTime
forall i a. Parser i a -> String -> Parser i a
<?> String
"diffTime"
where
unnamedParser :: Parser ByteString b
unnamedParser =
do
Scientific
amount <- Parser Scientific
D.scientific
b -> b
factor <- Parser (b -> b)
forall a. Fractional a => Parser (a -> a)
timeUnitFactor
b -> Parser ByteString b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
factor (Scientific -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
amount))
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime =
Parser NominalDiffTime
forall b. Fractional b => Parser ByteString b
unnamedParser Parser NominalDiffTime -> String -> Parser NominalDiffTime
forall i a. Parser i a -> String -> Parser i a
<?> String
"nominalDiffTime"
where
unnamedParser :: Parser ByteString b
unnamedParser =
do
Scientific
amount <- Parser Scientific
D.scientific
b -> b
factor <- Parser (b -> b)
forall a. Fractional a => Parser (a -> a)
timeUnitFactor
b -> Parser ByteString b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
factor (Scientific -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
amount))
timeUnitFactor :: Fractional a => Parser (a -> a)
timeUnitFactor :: Parser (a -> a)
timeUnitFactor =
(Word8 -> Bool) -> Parser ByteString
takeWhile Word8 -> Bool
A.word8IsAsciiAlpha Parser ByteString
-> (ByteString -> Parser (a -> a)) -> Parser (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ByteString
"" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
ByteString
"s" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
ByteString
"ms" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000)
ByteString
"μs" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000)
ByteString
"us" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000)
ByteString
"ns" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000000)
ByteString
"ps" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000000000)
ByteString
"m" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Num a => a -> a -> a
* a
60)
ByteString
"h" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Num a => a -> a -> a
* a
3600)
ByteString
"d" -> (a -> a) -> Parser (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
forall a. Num a => a -> a -> a
* a
86400)
ByteString
unit -> String -> Parser (a -> a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unsupported unit: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
unit)