module Attoparsec.Time.Text
(
  timeOfDayInISO8601,
  dayInISO8601,
  yearAndMonthInISO8601,
  timeZoneInISO8601,
  utcTimeInISO8601,
  diffTime,
  nominalDiffTime,
)
where

import Attoparsec.Time.Prelude hiding (take, takeWhile)
import Data.Attoparsec.Text
import qualified Attoparsec.Time.Pure as A
import qualified Attoparsec.Time.Validation as B
import qualified Data.Text as C


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 Char
anyChar Parser Char -> (Char -> Parser Bool) -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
'+' -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Char
'-' -> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Char
_ -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a
empty

decimalChar :: Parser Int
decimalChar :: Parser Int
decimalChar =
  (Char -> Int) -> (Int -> Bool) -> Parser Int
forall a. (Char -> a) -> (a -> Bool) -> Parser a
satisfyWith ((Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
48) (Int -> Int) -> (Char -> Int) -> Char -> Int
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
(&&) (Bool -> Bool -> Bool) -> (Int -> Bool) -> Int -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Int -> Bool -> Bool) -> (Int -> Bool) -> Int -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9))

decimalOfLength :: Num a => Int -> Parser a
decimalOfLength :: Int -> Parser a
decimalOfLength Int
length =
  (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
a a
b -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) a
0 ([a] -> a) -> Parser Text [a] -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Int -> Parser a -> Parser Text [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
length ((Int -> a) -> Parser Int -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Parser Int
decimalChar) Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid decimal length"

shortMonth :: Parser Int
shortMonth :: Parser Int
shortMonth =
  (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Text
C.toLower (Int -> Parser Text Text
take Int
3) Parser Text Text -> (Text -> Parser Int) -> Parser Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"jan" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
    Text
"feb" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
    Text
"mar" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
    Text
"apr" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
4
    Text
"may" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
5
    Text
"jun" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
6
    Text
"jul" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
7
    Text
"aug" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
8
    Text
"sep" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
9
    Text
"oct" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
10
    Text
"nov" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
11
    Text
"dec" -> Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
12
    Text
_ -> Parser Int
forall (f :: * -> *) a. Alternative f => f a
empty

picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength :: Int -> Parser Pico
picoWithBasisOfLength Int
basisLength =
  (\[Int]
a [Int]
b -> Integer -> Pico
forall k (a :: k). Integer -> Fixed a
MkFixed ((Integer -> Int -> Integer) -> Integer -> [Int] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Integer
a Int
b -> Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b) Integer
0 ([Int]
a [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int]
b))) ([Int] -> [Int] -> Pico)
-> Parser Text [Int] -> Parser Text ([Int] -> Pico)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Int]
beforePoint Parser Text ([Int] -> Pico) -> Parser Text [Int] -> Parser Pico
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Int]
afterPoint
  where
    resolution :: p
resolution =
      p
12
    beforePoint :: Parser Text [Int]
beforePoint =
      Int -> Parser Int -> Parser Text [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
basisLength Parser Int
decimalChar
    afterPoint :: Parser Text [Int]
afterPoint =
      Int -> [Int] -> Int -> [Int] -> [Int]
forall a. a -> [a] -> Int -> [a] -> [a]
padListFromRight Int
0 [] Int
forall p. Num p => p
resolution ([Int] -> [Int]) -> Parser Text [Int] -> Parser Text [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Parser Char
char Char
'.' Parser Char -> Parser Text [Int] -> Parser Text [Int]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Int -> Parser Text [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Int
decimalChar) Parser Text [Int] -> Parser Text [Int] -> Parser Text [Int]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Int] -> Parser Text [Int]
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 -> [a] -> [a]
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
accumulator) (Int -> Int
forall a. Enum a => a -> a
pred Int
length) [a]
tail
              [a]
_ -> [a] -> [a]
forall a. [a] -> [a]
reverse [a]
accumulator [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
length a
padding

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

{-|
>>> 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: Invalid decimal length"

>>> parseOnly timeOfDayInISO8601 "01:1:00"
Left "timeOfDayInISO8601 > minute: Failed reading: Invalid decimal length"
-}
{-# 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 Text (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Parser Int
hour Parser Int -> Parser Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
':') Parser Text (Int -> Pico -> TimeOfDay)
-> Parser Int -> Parser Text (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      (Parser Int
minute Parser Int -> Parser Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
':') Parser Text (Pico -> TimeOfDay) -> Parser Pico -> Parser TimeOfDay
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 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 Integer
forall a. Num a => Int -> Parser a
decimalOfLength Int
4
        Char -> Parser Char
char Char
'-'
        Int
month <- Int -> Parser Int
forall a. Num a => Int -> Parser a
decimalOfLength Int
2
        Char -> Parser Char
char Char
'-'
        Int
day <- Int -> Parser Int
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 -> 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)

{-|
>>> parseOnly yearAndMonthInISO8601 "2016-02"
Right (2016,2)
-}
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 :: Parser (Word, Word)
yearAndMonthInISO8601 =
  Parser (Word, Word)
forall a b. (Num a, Num b) => Parser Text (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 Text (a, b)
unnamedParser =
      do
        a
year <- Int -> Parser a
forall a. Num a => Int -> Parser a
decimalOfLength Int
4
        Char -> Parser Char
char Char
'-'
        b
month <- Int -> Parser b
forall a. Num a => Int -> Parser a
decimalOfLength Int
2
        (a, b) -> Parser Text (a, b)
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 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 =
          Char -> Parser Char
char Char
'Z' Parser Char -> 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 Text (Int -> Int -> TimeZone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
sign Parser Text (Int -> Int -> TimeZone)
-> Parser Int -> Parser Text (Int -> TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser Int
forall a. Num a => Int -> Parser a
decimalOfLength Int
2 Parser Text (Int -> TimeZone) -> Parser Int -> Parser TimeZone
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
':' Parser Char -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Int
forall a. Num 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. Num 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)

{-|
>>> 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 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
        Char -> Parser Char
char Char
'T'
        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)

{-|
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

>>> parseOnly diffTime "10μs"
Right 0.00001s

>>> 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 =
  Parser DiffTime
forall b. Fractional b => Parser Text b
unnamedParser Parser DiffTime -> String -> Parser DiffTime
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 <- Parser (b -> b)
forall a. Fractional a => Parser (a -> a)
timeUnitFactor
        b -> Parser Text 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))

{-|
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

>>> parseOnly nominalDiffTime "10μs"
Right 0.00001s

>>> 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 =
  Parser NominalDiffTime
forall b. Fractional b => Parser Text b
unnamedParser Parser NominalDiffTime -> String -> Parser NominalDiffTime
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 <- Parser (b -> b)
forall a. Fractional a => Parser (a -> a)
timeUnitFactor
        b -> Parser Text 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 =
  (Char -> Bool) -> Parser Text Text
takeWhile Char -> Bool
isAlpha Parser Text Text -> (Text -> Parser (a -> a)) -> Parser (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"" -> (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
    Text
"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
    Text
"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)
    Text
"μ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)
    Text
"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)
    Text
"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)
    Text
"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)
    Text
"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)
    Text
"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)
    Text
"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)
    Text
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
<> Text -> String
forall a. Show a => a -> String
show Text
unit)