{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Gogol.Data.Time
-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Gogol.Data.Time
  ( Time (..),
    Date (..),
    DateTime (..),
    Duration (..),
    _Time,
    _Date,
    _DateTime,
    _Duration,
  )
where

import Control.Lens
import Data.Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Attoparsec.Text
import Data.Bifunctor (first, second)
import Data.Bits ((.&.))
import Data.Char (ord)
import Data.Scientific (Scientific)
import Data.Scientific qualified as Sci
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as LText
import Data.Text.Lazy.Builder qualified as Build
import Data.Text.Lazy.Builder.Scientific qualified as Sci
import Data.Time
import GHC.Generics
import Web.HttpApiData
  ( FromHttpApiData (..),
    ToHttpApiData (..),
  )

-- | This SHOULD be a time in the format of hh:mm:ss.  It is
-- recommended that you use the "date-time" format instead of "time"
-- unless you need to transfer only the time part.
newtype Time = Time {Time -> TimeOfDay
fromTime :: TimeOfDay}
  deriving (Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
/= :: Time -> Time -> Bool
Eq, Eq Time
Eq Time =>
(Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
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
$ccompare :: Time -> Time -> Ordering
compare :: Time -> Time -> Ordering
$c< :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
>= :: Time -> Time -> Bool
$cmax :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
min :: Time -> Time -> Time
Ord, Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Time -> ShowS
showsPrec :: Int -> Time -> ShowS
$cshow :: Time -> String
show :: Time -> String
$cshowList :: [Time] -> ShowS
showList :: [Time] -> ShowS
Show, ReadPrec [Time]
ReadPrec Time
Int -> ReadS Time
ReadS [Time]
(Int -> ReadS Time)
-> ReadS [Time] -> ReadPrec Time -> ReadPrec [Time] -> Read Time
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Time
readsPrec :: Int -> ReadS Time
$creadList :: ReadS [Time]
readList :: ReadS [Time]
$creadPrec :: ReadPrec Time
readPrec :: ReadPrec Time
$creadListPrec :: ReadPrec [Time]
readListPrec :: ReadPrec [Time]
Read, (forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Time -> Rep Time x
from :: forall x. Time -> Rep Time x
$cto :: forall x. Rep Time x -> Time
to :: forall x. Rep Time x -> Time
Generic)

_Time :: Iso' Time TimeOfDay
_Time :: Iso' Time TimeOfDay
_Time = (Time -> TimeOfDay) -> (TimeOfDay -> Time) -> Iso' Time TimeOfDay
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Time -> TimeOfDay
fromTime TimeOfDay -> Time
Time

instance ToHttpApiData Time where
  toQueryParam :: Time -> Text
toQueryParam = String -> Text
Text.pack (String -> Text) -> (Time -> String) -> Time -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> String
forall a. Show a => a -> String
show (TimeOfDay -> String) -> (Time -> TimeOfDay) -> Time -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> TimeOfDay
fromTime

instance FromHttpApiData Time where
  parseQueryParam :: Text -> Either Text Time
parseQueryParam = (TimeOfDay -> Time) -> Either Text TimeOfDay -> Either Text Time
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second TimeOfDay -> Time
Time (Either Text TimeOfDay -> Either Text Time)
-> (Text -> Either Text TimeOfDay) -> Text -> Either Text Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser TimeOfDay -> Text -> Either Text TimeOfDay
forall a. Parser a -> Text -> Either Text a
parseText Parser TimeOfDay
timeParser

-- | This SHOULD be a date in the format of YYYY-MM-DD.  It is
-- recommended that you use the "date-time" format instead of "date"
-- unless you need to transfer only the date part.
newtype Date = Date {Date -> Day
unDate :: Day}
  deriving (Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
/= :: Date -> Date -> Bool
Eq, Eq Date
Eq Date =>
(Date -> Date -> Ordering)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> Ord Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
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
$ccompare :: Date -> Date -> Ordering
compare :: Date -> Date -> Ordering
$c< :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
>= :: Date -> Date -> Bool
$cmax :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
min :: Date -> Date -> Date
Ord, Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date -> ShowS
showsPrec :: Int -> Date -> ShowS
$cshow :: Date -> String
show :: Date -> String
$cshowList :: [Date] -> ShowS
showList :: [Date] -> ShowS
Show, ReadPrec [Date]
ReadPrec Date
Int -> ReadS Date
ReadS [Date]
(Int -> ReadS Date)
-> ReadS [Date] -> ReadPrec Date -> ReadPrec [Date] -> Read Date
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Date
readsPrec :: Int -> ReadS Date
$creadList :: ReadS [Date]
readList :: ReadS [Date]
$creadPrec :: ReadPrec Date
readPrec :: ReadPrec Date
$creadListPrec :: ReadPrec [Date]
readListPrec :: ReadPrec [Date]
Read, (forall x. Date -> Rep Date x)
-> (forall x. Rep Date x -> Date) -> Generic Date
forall x. Rep Date x -> Date
forall x. Date -> Rep Date x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Date -> Rep Date x
from :: forall x. Date -> Rep Date x
$cto :: forall x. Rep Date x -> Date
to :: forall x. Rep Date x -> Date
Generic, Date -> Text
Date -> ByteString
Date -> Builder
(Date -> Text)
-> (Date -> Builder)
-> (Date -> ByteString)
-> (Date -> Text)
-> (Date -> Builder)
-> ToHttpApiData Date
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Date -> Text
toUrlPiece :: Date -> Text
$ctoEncodedUrlPiece :: Date -> Builder
toEncodedUrlPiece :: Date -> Builder
$ctoHeader :: Date -> ByteString
toHeader :: Date -> ByteString
$ctoQueryParam :: Date -> Text
toQueryParam :: Date -> Text
$ctoEncodedQueryParam :: Date -> Builder
toEncodedQueryParam :: Date -> Builder
ToHttpApiData, Text -> Either Text Date
ByteString -> Either Text Date
(Text -> Either Text Date)
-> (ByteString -> Either Text Date)
-> (Text -> Either Text Date)
-> FromHttpApiData Date
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text Date
parseUrlPiece :: Text -> Either Text Date
$cparseHeader :: ByteString -> Either Text Date
parseHeader :: ByteString -> Either Text Date
$cparseQueryParam :: Text -> Either Text Date
parseQueryParam :: Text -> Either Text Date
FromHttpApiData)

_Date :: Iso' Date Day
_Date :: Iso' Date Day
_Date = (Date -> Day) -> (Day -> Date) -> Iso' Date Day
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Date -> Day
unDate Day -> Date
Date

-- | This SHOULD be a date in ISO 8601 format of YYYY-MM-
-- DDThh:mm:ssZ in UTC time. This is the recommended form of date/timestamp.
newtype DateTime = DateTime {DateTime -> UTCTime
unDateTime :: UTCTime}
  deriving (DateTime -> DateTime -> Bool
(DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool) -> Eq DateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DateTime -> DateTime -> Bool
== :: DateTime -> DateTime -> Bool
$c/= :: DateTime -> DateTime -> Bool
/= :: DateTime -> DateTime -> Bool
Eq, Eq DateTime
Eq DateTime =>
(DateTime -> DateTime -> Ordering)
-> (DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> DateTime)
-> (DateTime -> DateTime -> DateTime)
-> Ord DateTime
DateTime -> DateTime -> Bool
DateTime -> DateTime -> Ordering
DateTime -> DateTime -> DateTime
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
$ccompare :: DateTime -> DateTime -> Ordering
compare :: DateTime -> DateTime -> Ordering
$c< :: DateTime -> DateTime -> Bool
< :: DateTime -> DateTime -> Bool
$c<= :: DateTime -> DateTime -> Bool
<= :: DateTime -> DateTime -> Bool
$c> :: DateTime -> DateTime -> Bool
> :: DateTime -> DateTime -> Bool
$c>= :: DateTime -> DateTime -> Bool
>= :: DateTime -> DateTime -> Bool
$cmax :: DateTime -> DateTime -> DateTime
max :: DateTime -> DateTime -> DateTime
$cmin :: DateTime -> DateTime -> DateTime
min :: DateTime -> DateTime -> DateTime
Ord, Int -> DateTime -> ShowS
[DateTime] -> ShowS
DateTime -> String
(Int -> DateTime -> ShowS)
-> (DateTime -> String) -> ([DateTime] -> ShowS) -> Show DateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateTime -> ShowS
showsPrec :: Int -> DateTime -> ShowS
$cshow :: DateTime -> String
show :: DateTime -> String
$cshowList :: [DateTime] -> ShowS
showList :: [DateTime] -> ShowS
Show, ReadPrec [DateTime]
ReadPrec DateTime
Int -> ReadS DateTime
ReadS [DateTime]
(Int -> ReadS DateTime)
-> ReadS [DateTime]
-> ReadPrec DateTime
-> ReadPrec [DateTime]
-> Read DateTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DateTime
readsPrec :: Int -> ReadS DateTime
$creadList :: ReadS [DateTime]
readList :: ReadS [DateTime]
$creadPrec :: ReadPrec DateTime
readPrec :: ReadPrec DateTime
$creadListPrec :: ReadPrec [DateTime]
readListPrec :: ReadPrec [DateTime]
Read, (forall x. DateTime -> Rep DateTime x)
-> (forall x. Rep DateTime x -> DateTime) -> Generic DateTime
forall x. Rep DateTime x -> DateTime
forall x. DateTime -> Rep DateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DateTime -> Rep DateTime x
from :: forall x. DateTime -> Rep DateTime x
$cto :: forall x. Rep DateTime x -> DateTime
to :: forall x. Rep DateTime x -> DateTime
Generic, DateTime -> Text
DateTime -> ByteString
DateTime -> Builder
(DateTime -> Text)
-> (DateTime -> Builder)
-> (DateTime -> ByteString)
-> (DateTime -> Text)
-> (DateTime -> Builder)
-> ToHttpApiData DateTime
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: DateTime -> Text
toUrlPiece :: DateTime -> Text
$ctoEncodedUrlPiece :: DateTime -> Builder
toEncodedUrlPiece :: DateTime -> Builder
$ctoHeader :: DateTime -> ByteString
toHeader :: DateTime -> ByteString
$ctoQueryParam :: DateTime -> Text
toQueryParam :: DateTime -> Text
$ctoEncodedQueryParam :: DateTime -> Builder
toEncodedQueryParam :: DateTime -> Builder
ToHttpApiData, Text -> Either Text DateTime
ByteString -> Either Text DateTime
(Text -> Either Text DateTime)
-> (ByteString -> Either Text DateTime)
-> (Text -> Either Text DateTime)
-> FromHttpApiData DateTime
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text DateTime
parseUrlPiece :: Text -> Either Text DateTime
$cparseHeader :: ByteString -> Either Text DateTime
parseHeader :: ByteString -> Either Text DateTime
$cparseQueryParam :: Text -> Either Text DateTime
parseQueryParam :: Text -> Either Text DateTime
FromHttpApiData)

_DateTime :: Iso' DateTime UTCTime
_DateTime :: Iso' DateTime UTCTime
_DateTime = (DateTime -> UTCTime)
-> (UTCTime -> DateTime) -> Iso' DateTime UTCTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DateTime -> UTCTime
unDateTime UTCTime -> DateTime
DateTime

-- | A duration in seconds with up to nine fractional digits, terminated by 's'.
--
-- /Example/: @"3.5s"@.
newtype Duration = Duration {Duration -> Scientific
unDuration :: Scientific}
  deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, Eq Duration
Eq Duration =>
(Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
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
$ccompare :: Duration -> Duration -> Ordering
compare :: Duration -> Duration -> Ordering
$c< :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
>= :: Duration -> Duration -> Bool
$cmax :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
min :: Duration -> Duration -> Duration
Ord, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show, ReadPrec [Duration]
ReadPrec Duration
Int -> ReadS Duration
ReadS [Duration]
(Int -> ReadS Duration)
-> ReadS [Duration]
-> ReadPrec Duration
-> ReadPrec [Duration]
-> Read Duration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Duration
readsPrec :: Int -> ReadS Duration
$creadList :: ReadS [Duration]
readList :: ReadS [Duration]
$creadPrec :: ReadPrec Duration
readPrec :: ReadPrec Duration
$creadListPrec :: ReadPrec [Duration]
readListPrec :: ReadPrec [Duration]
Read, (forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Duration -> Rep Duration x
from :: forall x. Duration -> Rep Duration x
$cto :: forall x. Rep Duration x -> Duration
to :: forall x. Rep Duration x -> Duration
Generic)

_Duration :: Iso' Duration Scientific
_Duration :: Iso' Duration Scientific
_Duration = (Duration -> Scientific)
-> (Scientific -> Duration) -> Iso' Duration Scientific
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Duration -> Scientific
unDuration Scientific -> Duration
Duration

instance ToHttpApiData Duration where
  toQueryParam :: Duration -> Text
toQueryParam =
    LazyText -> Text
LText.toStrict
      (LazyText -> Text) -> (Duration -> LazyText) -> Duration -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Builder
seconds -> Builder -> LazyText
Build.toLazyText Builder
seconds LazyText -> LazyText -> LazyText
forall a. Semigroup a => a -> a -> a
<> LazyText
"s")
      (Builder -> LazyText)
-> (Duration -> Builder) -> Duration -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> Builder
Sci.formatScientificBuilder FPFormat
Sci.Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
9)
      (Scientific -> Builder)
-> (Duration -> Scientific) -> Duration -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Scientific
unDuration

instance FromHttpApiData Duration where
  parseQueryParam :: Text -> Either Text Duration
parseQueryParam = (Scientific -> Duration)
-> Either Text Scientific -> Either Text Duration
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Scientific -> Duration
Duration (Either Text Scientific -> Either Text Duration)
-> (Text -> Either Text Scientific) -> Text -> Either Text Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Scientific -> Text -> Either Text Scientific
forall a. Parser a -> Text -> Either Text a
parseText Parser Scientific
durationParser

instance ToJSON Time where toJSON :: Time -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Time -> Text) -> Time -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam

instance ToJSON Date where toJSON :: Date -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Date -> Text) -> Date -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam

instance ToJSON DateTime where toJSON :: DateTime -> Value
toJSON = UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON (UTCTime -> Value) -> (DateTime -> UTCTime) -> DateTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateTime -> UTCTime
unDateTime

instance ToJSON Duration where toJSON :: Duration -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Duration -> Text) -> Duration -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam

instance FromJSON Time where
  parseJSON :: Value -> Parser Time
parseJSON = (TimeOfDay -> Time) -> Parser TimeOfDay -> Parser Time
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeOfDay -> Time
Time (Parser TimeOfDay -> Parser Time)
-> (Value -> Parser TimeOfDay) -> Value -> Parser Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> Parser TimeOfDay) -> Value -> Parser TimeOfDay
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Time" (Parser TimeOfDay -> Text -> Parser TimeOfDay
forall a. Parser a -> Text -> Parser a
run Parser TimeOfDay
timeParser)

instance FromJSON Date where
  parseJSON :: Value -> Parser Date
parseJSON = (Day -> Date) -> Parser Day -> Parser Date
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Date
Date (Parser Day -> Parser Date)
-> (Value -> Parser Day) -> Value -> Parser Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> Parser Day) -> Value -> Parser Day
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Date" (Parser Day -> Text -> Parser Day
forall a. Parser a -> Text -> Parser a
run Parser Day
dayParser)

instance FromJSON DateTime where
  parseJSON :: Value -> Parser DateTime
parseJSON = (UTCTime -> DateTime) -> Parser UTCTime -> Parser DateTime
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> DateTime
DateTime (Parser UTCTime -> Parser DateTime)
-> (Value -> Parser UTCTime) -> Value -> Parser DateTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser UTCTime
forall a. FromJSON a => Value -> Parser a
parseJSON

instance FromJSON Duration where
  parseJSON :: Value -> Parser Duration
parseJSON = (Scientific -> Duration) -> Parser Scientific -> Parser Duration
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scientific -> Duration
Duration (Parser Scientific -> Parser Duration)
-> (Value -> Parser Scientific) -> Value -> Parser Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> Parser Scientific) -> Value -> Parser Scientific
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Duration" (Parser Scientific -> Text -> Parser Scientific
forall a. Parser a -> Text -> Parser a
run Parser Scientific
durationParser)

parseText :: Parser a -> Text -> Either Text a
parseText :: forall a. Parser a -> Text -> Either Text a
parseText Parser a
p = (String -> Text) -> Either String a -> Either Text a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
Text.pack (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly Parser a
p

-- | Parse a time of the form @HH:MM:SS@.
timeParser :: Parser TimeOfDay
timeParser :: Parser TimeOfDay
timeParser = do
  Int
h <- Parser Int
twoDigits Parser Int -> Parser Text Char -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':'
  Int
m <- Parser Int
twoDigits Parser Int -> Parser Text Char -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
':'
  Pico
s <- Parser Int
twoDigits Parser Int -> (Int -> Pico) -> Parser Text Pico
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60 Bool -> Bool -> Bool
&& Pico
s Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
< Pico
61
    then TimeOfDay -> Parser TimeOfDay
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)
    else String -> Parser TimeOfDay
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid time"

-- | Parse a date of the form @YYYY-MM-DD@.
dayParser :: Parser Day
dayParser :: Parser Day
dayParser = do
  Year
y <- Parser Year
forall a. Integral a => Parser a
decimal Parser Year -> Parser Text Char -> Parser Year
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-'
  Int
m <- Parser Int
twoDigits Parser Int -> Parser Text Char -> Parser Int
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'-'
  Int
d <- Parser Int
twoDigits
  Parser Day -> (Day -> Parser Day) -> Maybe Day -> Parser Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Day
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid date") Day -> Parser Day
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Year -> Int -> Int -> Maybe Day
fromGregorianValid Year
y Int
m Int
d)

durationParser :: Parser Scientific
durationParser :: Parser Scientific
durationParser = Double -> Scientific
forall a. RealFloat a => a -> Scientific
Sci.fromFloatDigits (Double -> Scientific) -> Parser Text Double -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Double
double Parser Text Double -> Parser Text Char -> Parser Text Double
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
's')

-- | Parse a two-digit integer (e.g. day of month, hour).
twoDigits :: Parser Int
twoDigits :: Parser Int
twoDigits = do
  Char
a <- Parser Text Char
digit
  Char
b <- Parser Text Char
digit
  let c2d :: Char -> Int
c2d Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15
  Int -> Parser Int
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$! Char -> Int
c2d Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
c2d Char
b

-- | Run an attoparsec parser as an aeson parser.
run :: Parser a -> Text -> Aeson.Parser a
run :: forall a. Parser a -> Text -> Parser a
run Parser a
p Text
t =
  case Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly (Parser a
p Parser a -> Parser Text () -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
t of
    Left String
err -> String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"could not parse date: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
    Right a
r -> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r