-- |
-- ASCII ByteString Parsers.
module Attoparsec.Time.ByteString
  ( timeOfDayInISO8601,
    dayInISO8601,
    yearAndMonthInISO8601,
    timeZoneInISO8601,
    utcTimeInISO8601,
    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.ByteString
import qualified Data.Attoparsec.ByteString.Char8 as D
import qualified Data.ByteString 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 Word8
anyWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
43 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Word8
45 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Word8
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

decimalOfLength :: (Integral a) => Int -> Parser a
decimalOfLength :: forall a. Integral a => 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 forall (m :: * -> *) a. Monad m => a -> m a
return (forall decimal. Integral decimal => ByteString -> decimal
A.decimalFromBytes ByteString
bytes)
      else 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 =
  forall k (a :: k). Integer -> Fixed a
MkFixed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a -> a
(+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Integer
beforePoint forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Word8 -> Parser Word8
word8 Word8
46 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall {b}. Integral b => Parser ByteString b
afterPoint) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0))
  where
    beforePoint :: Parser ByteString Integer
beforePoint =
      (forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Int -> Parser a
decimalOfLength Int
basisLength
    afterPoint :: Parser ByteString b
afterPoint =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall decimal. Integral decimal => ByteString -> decimal
updater 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 -> a
updater ByteString
bytes =
          let afterPoint :: a
afterPoint =
                forall decimal. Integral decimal => ByteString -> decimal
A.decimalFromBytes ByteString
bytes
              afterPointLength :: Int
afterPointLength =
                ByteString -> Int
C.length ByteString
bytes
              paddedAfterPoint :: a
paddedAfterPoint =
                if Int
afterPointLength forall a. Ord a => a -> a -> Bool
< Int
12
                  then a
afterPoint forall a. Num a => a -> a -> a
* (a
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
12 forall a. Num a => a -> a -> a
- Int
afterPointLength))
                  else a
afterPoint
           in a
paddedAfterPoint

{-# 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. Integral 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. Integral 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"

-- |
-- >>> parseOnly timeOfDayInISO8601 "05:03:58"
-- Right 05:03:58
--
-- >>> parseOnly timeOfDayInISO8601 "05:03:58.02"
-- Right 05:03:58.02
--
-- >>> parseOnly timeOfDayInISO8601 "05:03:58.020"
-- Right 05:03:58.02
--
-- Checks the elements to be within a proper range:
--
-- >>> parseOnly timeOfDayInISO8601 "24:00:00"
-- Left "timeOfDayInISO8601 > hour: Failed reading: Validator \"hour\" failed on the following input: 24"
--
-- >>> parseOnly timeOfDayInISO8601 "00:00:60"
-- Left "timeOfDayInISO8601 > second: Failed reading: Validator \"second\" failed on the following input: 60.000000000000"
--
-- Checks the elements to be of proper length:
--
-- >>> parseOnly timeOfDayInISO8601 "1:00:00"
-- Left "timeOfDayInISO8601 > hour: Failed reading: Not all chars are valid decimals"
--
-- >>> parseOnly timeOfDayInISO8601 "01:1:00"
-- Left "timeOfDayInISO8601 > minute: Failed reading: Not all chars are valid decimals"
{-# 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
<* Word8 -> Parser Word8
word8 Word8
58)
        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
<* Word8 -> Parser Word8
word8 Word8
58)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Pico
second)

-- |
-- >>> parseOnly dayInISO8601 "2017-02-01"
-- Right 2017-02-01
--
-- Checks the elements to be in proper range:
--
-- >>> parseOnly dayInISO8601 "2017-13-01"
-- Left "dayInISO8601: Failed reading: Invalid combination of year month and day: (2017,13,1)"
--
-- That is accounting for leap year:
--
-- >>> parseOnly dayInISO8601 "2017-02-29"
-- Left "dayInISO8601: Failed reading: Invalid combination of year month and day: (2017,2,29)"
--
-- >>> parseOnly dayInISO8601 "2016-02-29"
-- Right 2016-02-29
{-# 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. Integral a => Int -> Parser a
decimalOfLength Int
4
        Word8 -> Parser Word8
word8 Word8
45
        Int
month <- forall a. Integral a => Int -> Parser a
decimalOfLength Int
2
        Word8 -> Parser Word8
word8 Word8
45
        Int
day <- 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 -> 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)

-- |
-- >>> parseOnly yearAndMonthInISO8601 "2016-02"
-- Right (2016,2)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 =
  forall {a} {b}.
(Integral a, Integral b) =>
Parser ByteString (a, b)
unnamedParser forall i a. Parser i a -> String -> Parser i a
<?> String
"yearAndMonthInISO8601"
  where
    unnamedParser :: Parser ByteString (a, b)
unnamedParser =
      do
        a
year <- forall a. Integral a => Int -> Parser a
decimalOfLength Int
4
        Word8 -> Parser Word8
word8 Word8
45
        b
month <- forall a. Integral a => Int -> Parser a
decimalOfLength Int
2
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
year, b
month)

-- |
-- >>> parseOnly timeZoneInISO8601 "+01:00"
-- Right +0100
--
-- >>> parseOnly timeZoneInISO8601 "+0100"
-- Right +0100
--
-- >>> parseOnly timeZoneInISO8601 "-0100"
-- Right -0100
--
-- >>> parseOnly timeZoneInISO8601 "Z"
-- Right UTC
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 =
          Word8 -> Parser Word8
word8 Word8
90 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. Integral a => Int -> Parser a
decimalOfLength Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Parser Word8
word8 Word8
58 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Int -> Parser a
decimalOfLength Int
2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Integral 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)

-- |
-- >>> parseOnly utcTimeInISO8601 "2017-02-01T05:03:58+01:00"
-- Right 2017-02-01 04:03:58 UTC
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
        Word8 -> Parser Word8
word8 Word8
84
        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)

-- |
-- No suffix implies the "seconds" unit:
--
-- >>> parseOnly diffTime "10"
-- Right 10s
--
-- Various units (seconds, minutes, hours, days):
--
-- >>> parseOnly diffTime "10s"
-- Right 10s
--
-- >>> parseOnly diffTime "10m"
-- Right 600s
--
-- >>> parseOnly diffTime "10h"
-- Right 36000s
--
-- >>> parseOnly diffTime "10d"
-- Right 864000s
--
-- Metric prefixes to seconds (down to Pico):
--
-- >>> parseOnly diffTime "10ms"
-- Right 0.01s
--
-- Notice that \"μs\" is not supported, because it's not ASCII.
--
-- >>> parseOnly diffTime "10us"
-- Right 0.00001s
--
-- >>> parseOnly diffTime "10ns"
-- Right 0.00000001s
--
-- >>> parseOnly diffTime "10ps"
-- Right 0.00000000001s
--
-- Negative values:
--
-- >>> parseOnly diffTime "-1s"
-- Right -1s
--
-- Unsupported units:
--
-- >>> parseOnly diffTime "1k"
-- Left "diffTime: Failed reading: Unsupported unit: \"k\""
diffTime :: Parser DiffTime
diffTime :: Parser DiffTime
diffTime =
  forall {b}. Fractional b => Parser ByteString b
unnamedParser 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 <- 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))

-- |
-- No suffix implies the "seconds" unit:
--
-- >>> parseOnly nominalDiffTime "10"
-- Right 10s
--
-- Various units (seconds, minutes, hours, days):
--
-- >>> parseOnly nominalDiffTime "10s"
-- Right 10s
--
-- >>> parseOnly nominalDiffTime "10m"
-- Right 600s
--
-- >>> parseOnly nominalDiffTime "10h"
-- Right 36000s
--
-- >>> parseOnly nominalDiffTime "10d"
-- Right 864000s
--
-- Metric prefixes to seconds (down to Pico):
--
-- >>> parseOnly nominalDiffTime "10ms"
-- Right 0.01s
--
-- Notice that \"μs\" is not supported, because it's not ASCII.
--
-- >>> parseOnly nominalDiffTime "10us"
-- Right 0.00001s
--
-- >>> parseOnly nominalDiffTime "10ns"
-- Right 0.00000001s
--
-- >>> parseOnly nominalDiffTime "10ps"
-- Right 0.00000000001s
--
-- Negative values:
--
-- >>> parseOnly nominalDiffTime "-1s"
-- Right -1s
--
-- Unsupported units:
--
-- >>> parseOnly nominalDiffTime "1k"
-- Left "nominalDiffTime: Failed reading: Unsupported unit: \"k\""
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime :: Parser NominalDiffTime
nominalDiffTime =
  forall {b}. Fractional b => Parser ByteString b
unnamedParser 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 <- 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 =
  (Word8 -> Bool) -> Parser ByteString
takeWhile Word8 -> Bool
A.word8IsAsciiAlpha forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ByteString
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    ByteString
"s" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    ByteString
"ms" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000)
    ByteString
"μs" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000)
    ByteString
"us" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000)
    ByteString
"ns" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000000)
    ByteString
"ps" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => a -> a -> a
/ a
1000000000000)
    ByteString
"m" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
60)
    ByteString
"h" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
3600)
    ByteString
"d" -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => a -> a -> a
* a
86400)
    ByteString
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 ByteString
unit)