-- |
-- Module      : Amazonka.Data.Time
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Time
  ( -- * Time
    Format (..),
    Time (..),
    _Time,

    -- ** Formats
    UTCTime,
    RFC822,
    ISO8601,
    BasicTime,
    AWSTime,
    POSIX,
  )
where

import Amazonka.Core.Lens.Internal (iso)
import Amazonka.Data.ByteString
import Amazonka.Data.JSON
import Amazonka.Data.Query
import Amazonka.Data.Text
import Amazonka.Data.XML
import Amazonka.Prelude
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Attoparsec.Text as A
import qualified Data.Attoparsec.Text as AText
import qualified Data.ByteString.Char8 as BS
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Data.Time as Time
import Data.Time.Clock.POSIX
import Data.Time.Format (defaultTimeLocale, formatTime)

data Format
  = RFC822Format
  | ISO8601Format
  | BasicFormat
  | AWSFormat
  | POSIXFormat
  deriving stock (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
(Int -> ReadS Format)
-> ReadS [Format]
-> ReadPrec Format
-> ReadPrec [Format]
-> Read Format
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Format
readsPrec :: Int -> ReadS Format
$creadList :: ReadS [Format]
readList :: ReadS [Format]
$creadPrec :: ReadPrec Format
readPrec :: ReadPrec Format
$creadListPrec :: ReadPrec [Format]
readListPrec :: ReadPrec [Format]
Read, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show, (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Format -> Rep Format x
from :: forall x. Format -> Rep Format x
$cto :: forall x. Rep Format x -> Format
to :: forall x. Rep Format x -> Format
Generic)

newtype Time (a :: Format) = Time {forall (a :: Format). Time a -> UTCTime
fromTime :: UTCTime}
  deriving stock (Int -> Time a -> ShowS
[Time a] -> ShowS
Time a -> String
(Int -> Time a -> ShowS)
-> (Time a -> String) -> ([Time a] -> ShowS) -> Show (Time a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: Format). Int -> Time a -> ShowS
forall (a :: Format). [Time a] -> ShowS
forall (a :: Format). Time a -> String
$cshowsPrec :: forall (a :: Format). Int -> Time a -> ShowS
showsPrec :: Int -> Time a -> ShowS
$cshow :: forall (a :: Format). Time a -> String
show :: Time a -> String
$cshowList :: forall (a :: Format). [Time a] -> ShowS
showList :: [Time a] -> ShowS
Show, ReadPrec [Time a]
ReadPrec (Time a)
Int -> ReadS (Time a)
ReadS [Time a]
(Int -> ReadS (Time a))
-> ReadS [Time a]
-> ReadPrec (Time a)
-> ReadPrec [Time a]
-> Read (Time a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (a :: Format). ReadPrec [Time a]
forall (a :: Format). ReadPrec (Time a)
forall (a :: Format). Int -> ReadS (Time a)
forall (a :: Format). ReadS [Time a]
$creadsPrec :: forall (a :: Format). Int -> ReadS (Time a)
readsPrec :: Int -> ReadS (Time a)
$creadList :: forall (a :: Format). ReadS [Time a]
readList :: ReadS [Time a]
$creadPrec :: forall (a :: Format). ReadPrec (Time a)
readPrec :: ReadPrec (Time a)
$creadListPrec :: forall (a :: Format). ReadPrec [Time a]
readListPrec :: ReadPrec [Time a]
Read, Time a -> Time a -> Bool
(Time a -> Time a -> Bool)
-> (Time a -> Time a -> Bool) -> Eq (Time a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Format). Time a -> Time a -> Bool
$c== :: forall (a :: Format). Time a -> Time a -> Bool
== :: Time a -> Time a -> Bool
$c/= :: forall (a :: Format). Time a -> Time a -> Bool
/= :: Time a -> Time a -> Bool
Eq, Eq (Time a)
Eq (Time a)
-> (Time a -> Time a -> Ordering)
-> (Time a -> Time a -> Bool)
-> (Time a -> Time a -> Bool)
-> (Time a -> Time a -> Bool)
-> (Time a -> Time a -> Bool)
-> (Time a -> Time a -> Time a)
-> (Time a -> Time a -> Time a)
-> Ord (Time a)
Time a -> Time a -> Bool
Time a -> Time a -> Ordering
Time a -> Time a -> Time a
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
forall (a :: Format). Eq (Time a)
forall (a :: Format). Time a -> Time a -> Bool
forall (a :: Format). Time a -> Time a -> Ordering
forall (a :: Format). Time a -> Time a -> Time a
$ccompare :: forall (a :: Format). Time a -> Time a -> Ordering
compare :: Time a -> Time a -> Ordering
$c< :: forall (a :: Format). Time a -> Time a -> Bool
< :: Time a -> Time a -> Bool
$c<= :: forall (a :: Format). Time a -> Time a -> Bool
<= :: Time a -> Time a -> Bool
$c> :: forall (a :: Format). Time a -> Time a -> Bool
> :: Time a -> Time a -> Bool
$c>= :: forall (a :: Format). Time a -> Time a -> Bool
>= :: Time a -> Time a -> Bool
$cmax :: forall (a :: Format). Time a -> Time a -> Time a
max :: Time a -> Time a -> Time a
$cmin :: forall (a :: Format). Time a -> Time a -> Time a
min :: Time a -> Time a -> Time a
Ord, (forall x. Time a -> Rep (Time a) x)
-> (forall x. Rep (Time a) x -> Time a) -> Generic (Time a)
forall x. Rep (Time a) x -> Time a
forall x. Time a -> Rep (Time a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: Format) x. Rep (Time a) x -> Time a
forall (a :: Format) x. Time a -> Rep (Time a) x
$cfrom :: forall (a :: Format) x. Time a -> Rep (Time a) x
from :: forall x. Time a -> Rep (Time a) x
$cto :: forall (a :: Format) x. Rep (Time a) x -> Time a
to :: forall x. Rep (Time a) x -> Time a
Generic)
  deriving newtype (Time a -> ()
(Time a -> ()) -> NFData (Time a)
forall a. (a -> ()) -> NFData a
forall (a :: Format). Time a -> ()
$crnf :: forall (a :: Format). Time a -> ()
rnf :: Time a -> ()
NFData)

instance Hashable (Time a) where
  hashWithSalt :: Int -> Time a -> Int
hashWithSalt Int
salt (Time (Time.UTCTime (Time.ModifiedJulianDay Integer
d) DiffTime
t)) =
    Int
salt
      Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
d
      Int -> Rational -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` DiffTime -> Rational
forall a. Real a => a -> Rational
toRational DiffTime
t

_Time :: Iso' (Time a) UTCTime
_Time :: forall (a :: Format) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p UTCTime (f UTCTime) -> p (Time a) (f (Time a))
_Time = (Time a -> UTCTime)
-> (UTCTime -> Time a) -> Iso (Time a) (Time a) UTCTime UTCTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Time a -> UTCTime
forall (a :: Format). Time a -> UTCTime
fromTime UTCTime -> Time a
forall (a :: Format). UTCTime -> Time a
Time

convert :: Time a -> Time b
convert :: forall (a :: Format) (b :: Format). Time a -> Time b
convert = Time a -> Time b
forall a b. Coercible a b => a -> b
coerce

type RFC822 = Time 'RFC822Format

type ISO8601 = Time 'ISO8601Format

type BasicTime = Time 'BasicFormat

type AWSTime = Time 'AWSFormat

type POSIX = Time 'POSIXFormat

class TimeFormat a where
  format :: proxy a -> String

instance TimeFormat RFC822 where
  format :: forall (proxy :: * -> *). proxy RFC822 -> String
format proxy RFC822
_ = String
"%a, %d %b %Y %H:%M:%S %Z"

instance TimeFormat ISO8601 where
  format :: forall (proxy :: * -> *). proxy ISO8601 -> String
format proxy ISO8601
_ = String
"%FT%XZ"

instance TimeFormat BasicTime where
  format :: forall (proxy :: * -> *). proxy BasicTime -> String
format proxy BasicTime
_ = String
"%Y%m%d"

instance TimeFormat AWSTime where
  format :: forall (proxy :: * -> *). proxy AWSTime -> String
format proxy AWSTime
_ = String
"%Y%m%dT%H%M%SZ"

instance FromText (Time fmt) where
  fromText :: Text -> Either String (Time fmt)
fromText = Parser (Time fmt) -> Text -> Either String (Time fmt)
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser (Time fmt)
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser (Time fmt) -> Parser (Time fmt) -> Parser (Time fmt)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Time fmt)
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser (Time fmt) -> Parser Text () -> Parser (Time fmt)
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 ()
A.endOfInput)

parseFormattedTime :: A.Parser (Time a)
parseFormattedTime :: forall (a :: Format). Parser (Time a)
parseFormattedTime = do
  String
s <- Text -> String
Text.unpack (Text -> String) -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
AText.takeText

  let parse :: String -> A.Parser (Time a)
      parse :: forall (a :: Format). String -> Parser (Time a)
parse String
fmt =
        case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
Time.parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt String
s of
          Just UTCTime
x -> Time a -> Parser (Time a)
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Time a
forall (a :: Format). UTCTime -> Time a
Time UTCTime
x)
          Maybe UTCTime
Nothing ->
            String -> Parser (Time a)
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
              ( String
"Unable to parse Time format "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
fmt
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
              )

  String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse (Proxy RFC822 -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
forall (proxy :: * -> *). proxy RFC822 -> String
format (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @RFC822))
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse (Proxy ISO8601 -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
forall (proxy :: * -> *). proxy ISO8601 -> String
format (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ISO8601))
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse (Proxy BasicTime -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
forall (proxy :: * -> *). proxy BasicTime -> String
format (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BasicTime))
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse (Proxy AWSTime -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
forall (proxy :: * -> *). proxy AWSTime -> String
format (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AWSTime))
    -- Deprecated ISO8601 format exhibited in the AWS-supplied examples.
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse String
"%FT%X%Q%Z"
    -- Exhaustive Failure
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failure parsing Time from value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s)

parseUnixTimestamp :: A.Parser (Time a)
parseUnixTimestamp :: forall (a :: Format). Parser (Time a)
parseUnixTimestamp =
  UTCTime -> Time a
forall (a :: Format). UTCTime -> Time a
Time (UTCTime -> Time a) -> (Double -> UTCTime) -> Double -> Time a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Double -> POSIXTime) -> Double -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    (Double -> Time a) -> Parser Text Double -> Parser Text (Time a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Double
AText.double
    Parser Text (Time a) -> Parser Text () -> Parser Text (Time 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 ()
AText.endOfInput
    Parser Text (Time a)
-> Parser Text (Time a) -> Parser Text (Time a)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Text (Time a)
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failure parsing Unix Timestamp"

instance ToText RFC822 where
  toText :: RFC822 -> Text
toText = String -> Text
Text.pack (String -> Text) -> (RFC822 -> String) -> RFC822 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RFC822 -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText ISO8601 where
  toText :: ISO8601 -> Text
toText = String -> Text
Text.pack (String -> Text) -> (ISO8601 -> String) -> ISO8601 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601 -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText BasicTime where
  toText :: BasicTime -> Text
toText = String -> Text
Text.pack (String -> Text) -> (BasicTime -> String) -> BasicTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicTime -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText AWSTime where
  toText :: AWSTime -> Text
toText = String -> Text
Text.pack (String -> Text) -> (AWSTime -> String) -> AWSTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AWSTime -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText POSIX where
  toText :: POSIX -> Text
toText (Time UTCTime
t) = Integer -> Text
forall a. ToText a => a -> Text
toText (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer)

renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String
renderFormattedTime :: forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime (Time UTCTime
t) =
  TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime
    TimeLocale
defaultTimeLocale
    (Proxy (Time a) -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
forall (proxy :: * -> *). proxy (Time a) -> String
format (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Time a)))
    -- Convert `t` to a GMT `ZonedTime`, because otherwise the
    -- `FormatTime` instance for `UTCTime` converts to UTC `ZonedTime`
    -- for us. While they are the same offset, a UTC `ZonedTime` emits
    -- `UTC` instead of `GMT` when formatted by `RFC822`'s
    -- `TimeFormat`, which is not a valid `zone` in RFC 822's grammar.
    (TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime (String -> TimeZone
forall a. Read a => String -> a
read String
"GMT") UTCTime
t)

instance FromXML RFC822 where
  parseXML :: [Node] -> Either String RFC822
parseXML = String -> [Node] -> Either String RFC822
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"RFC822"

instance FromXML ISO8601 where
  parseXML :: [Node] -> Either String ISO8601
parseXML = String -> [Node] -> Either String ISO8601
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"ISO8601"

instance FromXML AWSTime where
  parseXML :: [Node] -> Either String AWSTime
parseXML = String -> [Node] -> Either String AWSTime
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"AWSTime"

instance FromXML BasicTime where
  parseXML :: [Node] -> Either String BasicTime
parseXML = String -> [Node] -> Either String BasicTime
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"BasicTime"

instance FromJSON RFC822 where
  parseJSON :: Value -> Parser RFC822
parseJSON = String -> Value -> Parser RFC822
forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"RFC822"

instance FromJSON ISO8601 where
  parseJSON :: Value -> Parser ISO8601
parseJSON = String -> Value -> Parser ISO8601
forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"ISO8601"

instance FromJSON AWSTime where
  parseJSON :: Value -> Parser AWSTime
parseJSON = String -> Value -> Parser AWSTime
forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"AWSTime"

instance FromJSON BasicTime where
  parseJSON :: Value -> Parser BasicTime
parseJSON = String -> Value -> Parser BasicTime
forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"BasicTime"

-- This is a somewhat unfortunate hack to support the bizzare apigateway
-- occurence of returning ISO8601 or POSIX timestamps in unknown scenarios.
--
-- See: https://github.com/brendanhay/amazonka/issues/291
instance FromJSON POSIX where
  parseJSON :: Value -> Parser POSIX
parseJSON Value
o = (ISO8601 -> POSIX) -> Parser ISO8601 -> Parser POSIX
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ISO8601 -> POSIX
forall (a :: Format) (b :: Format). Time a -> Time b
convert (Value -> Parser ISO8601
str Value
o) Parser POSIX -> Parser POSIX -> Parser POSIX
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser POSIX
num Value
o
    where
      str :: Value -> Aeson.Parser ISO8601
      str :: Value -> Parser ISO8601
str = Value -> Parser ISO8601
forall a. FromJSON a => Value -> Parser a
parseJSON

      num :: Value -> Aeson.Parser POSIX
      num :: Value -> Parser POSIX
num =
        String -> (Scientific -> Parser POSIX) -> Value -> Parser POSIX
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific
          String
"POSIX"
          ( POSIX -> Parser POSIX
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (POSIX -> Parser POSIX)
-> (Scientific -> POSIX) -> Scientific -> Parser POSIX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIX
forall (a :: Format). UTCTime -> Time a
Time
              (UTCTime -> POSIX)
-> (Scientific -> UTCTime) -> Scientific -> POSIX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
              (POSIXTime -> UTCTime)
-> (Scientific -> POSIXTime) -> Scientific -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac
          )

instance ToByteString RFC822 where
  toBS :: RFC822 -> ByteString
toBS = String -> ByteString
BS.pack (String -> ByteString)
-> (RFC822 -> String) -> RFC822 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RFC822 -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString ISO8601 where
  toBS :: ISO8601 -> ByteString
toBS = String -> ByteString
BS.pack (String -> ByteString)
-> (ISO8601 -> String) -> ISO8601 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601 -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString BasicTime where
  toBS :: BasicTime -> ByteString
toBS = String -> ByteString
BS.pack (String -> ByteString)
-> (BasicTime -> String) -> BasicTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicTime -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString AWSTime where
  toBS :: AWSTime -> ByteString
toBS = String -> ByteString
BS.pack (String -> ByteString)
-> (AWSTime -> String) -> AWSTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AWSTime -> String
forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToQuery RFC822 where
  toQuery :: RFC822 -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (RFC822 -> ByteString) -> RFC822 -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RFC822 -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery ISO8601 where
  toQuery :: ISO8601 -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (ISO8601 -> ByteString) -> ISO8601 -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ISO8601 -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery BasicTime where
  toQuery :: BasicTime -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (BasicTime -> ByteString) -> BasicTime -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BasicTime -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery AWSTime where
  toQuery :: AWSTime -> QueryString
toQuery = ByteString -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (ByteString -> QueryString)
-> (AWSTime -> ByteString) -> AWSTime -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AWSTime -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery POSIX where
  toQuery :: POSIX -> QueryString
toQuery (Time UTCTime
t) = Integer -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer)

instance ToXML RFC822 where
  toXML :: RFC822 -> XML
toXML = RFC822 -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML ISO8601 where
  toXML :: ISO8601 -> XML
toXML = ISO8601 -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML AWSTime where
  toXML :: AWSTime -> XML
toXML = AWSTime -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML BasicTime where
  toXML :: BasicTime -> XML
toXML = BasicTime -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToJSON RFC822 where
  toJSON :: RFC822 -> Value
toJSON = RFC822 -> Value
forall a. ToText a => a -> Value
toJSONText

instance ToJSON ISO8601 where
  toJSON :: ISO8601 -> Value
toJSON = ISO8601 -> Value
forall a. ToText a => a -> Value
toJSONText

instance ToJSON AWSTime where
  toJSON :: AWSTime -> Value
toJSON = AWSTime -> Value
forall a. ToText a => a -> Value
toJSONText

instance ToJSON BasicTime where
  toJSON :: BasicTime -> Value
toJSON = BasicTime -> Value
forall a. ToText a => a -> Value
toJSONText

instance ToJSON POSIX where
  toJSON :: POSIX -> Value
toJSON (Time UTCTime
t) =
    Scientific -> Value
Aeson.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$
      Integer -> Int -> Scientific
Scientific.scientific (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer) Int
0