-- |
-- Module      : Amazonka.Data.Time
-- Copyright   : (c) 2013-2021 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.Data.ByteString
import Amazonka.Data.JSON
import Amazonka.Data.Query
import Amazonka.Data.Text
import Amazonka.Data.XML
import Amazonka.Lens (iso)
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, iso8601DateFormat)

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
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: 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
readListPrec :: ReadPrec [Format]
$creadListPrec :: ReadPrec [Format]
readPrec :: ReadPrec Format
$creadPrec :: ReadPrec Format
readList :: ReadS [Format]
$creadList :: ReadS [Format]
readsPrec :: Int -> ReadS Format
$creadsPrec :: Int -> ReadS 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
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic)

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

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 :: proxy RFC822 -> String
format proxy RFC822
_ = String
"%a, %d %b %Y %H:%M:%S GMT"

instance TimeFormat ISO8601 where
  format :: proxy ISO8601 -> String
format proxy ISO8601
_ = Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%XZ")

instance TimeFormat BasicTime where
  format :: proxy BasicTime -> String
format proxy BasicTime
_ = String
"%Y%m%d"

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

instance FromText BasicTime where
  fromText :: Text -> Either String BasicTime
fromText = Parser BasicTime -> Text -> Either String BasicTime
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser BasicTime
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser BasicTime -> Parser BasicTime -> Parser BasicTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser BasicTime
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser BasicTime -> Parser Text () -> Parser BasicTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)

instance FromText AWSTime where
  fromText :: Text -> Either String AWSTime
fromText = Parser AWSTime -> Text -> Either String AWSTime
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser AWSTime
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser AWSTime -> Parser AWSTime -> Parser AWSTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AWSTime
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser AWSTime -> Parser Text () -> Parser AWSTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)

instance FromText RFC822 where
  fromText :: Text -> Either String RFC822
fromText = Parser RFC822 -> Text -> Either String RFC822
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser RFC822
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser RFC822 -> Parser RFC822 -> Parser RFC822
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RFC822
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser RFC822 -> Parser Text () -> Parser RFC822
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)

instance FromText ISO8601 where
  fromText :: Text -> Either String ISO8601
fromText = Parser ISO8601 -> Text -> Either String ISO8601
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser ISO8601
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser ISO8601 -> Parser ISO8601 -> Parser ISO8601
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ISO8601
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser ISO8601 -> Parser Text () -> Parser ISO8601
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)

instance FromText POSIX where
  fromText :: Text -> Either String POSIX
fromText = Parser POSIX -> Text -> Either String POSIX
forall a. Parser a -> Text -> Either String a
A.parseOnly ((Parser POSIX
forall (a :: Format). Parser (Time a)
parseUnixTimestamp Parser POSIX -> Parser POSIX -> Parser POSIX
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser POSIX
forall (a :: Format). Parser (Time a)
parseFormattedTime) Parser POSIX -> Parser Text () -> Parser POSIX
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 :: 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 :: 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 (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 (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
format (Proxy RFC822
forall k (t :: k). Proxy t
Proxy @RFC822))
    Parser (Time a) -> Parser (Time a) -> Parser (Time 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
format (Proxy ISO8601
forall k (t :: k). Proxy t
Proxy @ISO8601))
    Parser (Time a) -> Parser (Time a) -> Parser (Time 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
format (Proxy BasicTime
forall k (t :: k). Proxy t
Proxy @BasicTime))
    Parser (Time a) -> Parser (Time a) -> Parser (Time 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
format (Proxy AWSTime
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time a)
forall (a :: Format). String -> Parser (Time a)
parse (Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%X%Q%Z"))
    -- Exhaustive Failure
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time 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 :: 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 (Time a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Double
AText.double Parser (Time a) -> Parser Text () -> Parser (Time a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AText.endOfInput
    Parser (Time a) -> Parser (Time a) -> Parser (Time a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser (Time 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 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 :: Time a -> String
renderFormattedTime (Time UTCTime
t) =
  TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (Proxy (Time a) -> String
forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (Proxy (Time a)
forall k (t :: k). Proxy t
Proxy @(Time a))) 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 (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 (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 (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 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 a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer) Int
0