module Network.AWS.Data.Internal.Time
( Format (..)
, Time (..)
, _Time
, UTCTime
, RFC822
, ISO8601
, BasicTime
, AWSTime
, POSIX
) where
import Control.Applicative
import Control.Lens
import Data.Aeson
import Data.Attoparsec.Text (Parser)
import qualified Data.Attoparsec.Text as AText
import qualified Data.ByteString.Char8 as BS
import Data.Function (on)
import Data.Tagged
import qualified Data.Text as Text
import Data.Time
import Data.Time.Clock.POSIX
import Network.AWS.Data.Internal.ByteString
import Network.AWS.Data.Internal.JSON
import Network.AWS.Data.Internal.Query
import Network.AWS.Data.Internal.Text
import Network.AWS.Data.Internal.XML
import System.Locale
data Format
= RFC822Format
| ISO8601Format
| BasicFormat
| AWSFormat
| POSIXFormat
deriving (Eq, Show)
data Time :: Format -> * where
Time :: UTCTime -> Time a
LocaleTime :: TimeLocale -> UTCTime -> Time a
deriving instance Show (Time a)
deriving instance Eq (Time a)
instance Ord (Time (a :: Format)) where
compare = compare `on` ts
where
ts (Time t) = (t, defaultTimeLocale)
ts (LocaleTime l t) = (t, l)
_Time :: Iso' (Time a) UTCTime
_Time = iso (\case; Time a -> a; LocaleTime _ a -> a) Time
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 :: Tagged a String
instance TimeFormat RFC822 where format = Tagged "%a, %d %b %Y %H:%M:%S GMT"
instance TimeFormat ISO8601 where format = Tagged (iso8601DateFormat (Just "%X%QZ"))
instance TimeFormat BasicTime where format = Tagged "%Y%m%d"
instance TimeFormat AWSTime where format = Tagged "%Y%m%dT%H%M%SZ"
instance FromText RFC822 where parser = parseFormattedTime
instance FromText ISO8601 where parser = parseFormattedTime
instance FromText BasicTime where parser = parseFormattedTime
instance FromText AWSTime where parser = parseFormattedTime
instance FromText POSIX where
parser = Time . posixSecondsToUTCTime . realToFrac
<$> (parser :: Parser Integer)
parseFormattedTime :: forall a. TimeFormat (Time a) => Parser (Time a)
parseFormattedTime = do
x <- Text.unpack <$> AText.takeText
p (parseTime defaultTimeLocale (untag f) x) x
where
p :: Maybe UTCTime -> String -> Parser (Time a)
p Nothing s = fail ("Unable to parse " ++ untag f ++ " from " ++ s)
p (Just x) _ = return (Time x)
f :: Tagged (Time a) String
f = format
instance ToText RFC822 where toText = Text.pack . renderFormattedTime
instance ToText ISO8601 where toText = Text.pack . renderFormattedTime
instance ToText BasicTime where toText = Text.pack . renderFormattedTime
instance ToText AWSTime where toText = Text.pack . renderFormattedTime
instance ToText POSIX where
toText t = toText time
where
time :: Integer
time = truncate . utcTimeToPOSIXSeconds $
case t of
Time x -> x
LocaleTime _ x -> x
renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String
renderFormattedTime x = formatTime l (untag f) t
where
(l, t) = case x of
Time t' -> (defaultTimeLocale, t')
LocaleTime l' t' -> (l', t')
f :: Tagged (Time a) String
f = format
instance FromXML RFC822 where parseXML = parseXMLText "RFC822"
instance FromXML ISO8601 where parseXML = parseXMLText "ISO8601"
instance FromXML AWSTime where parseXML = parseXMLText "AWSTime"
instance FromXML BasicTime where parseXML = parseXMLText "BasicTime"
instance FromXML POSIX where parseXML = parseXMLText "POSIX"
instance FromJSON RFC822 where parseJSON = parseJSONText "RFC822"
instance FromJSON ISO8601 where parseJSON = parseJSONText "ISO8601"
instance FromJSON AWSTime where parseJSON = parseJSONText "AWSTime"
instance FromJSON BasicTime where parseJSON = parseJSONText "BasicTime"
instance FromJSON POSIX where parseJSON = parseJSONText "POSIX"
instance ToByteString RFC822 where toBS = BS.pack . renderFormattedTime
instance ToByteString ISO8601 where toBS = BS.pack . renderFormattedTime
instance ToByteString BasicTime where toBS = BS.pack . renderFormattedTime
instance ToByteString AWSTime where toBS = BS.pack . renderFormattedTime
instance ToQuery RFC822 where toQuery = toQuery . toBS
instance ToQuery ISO8601 where toQuery = toQuery . toBS
instance ToQuery BasicTime where toQuery = toQuery . toBS
instance ToQuery AWSTime where toQuery = toQuery . toBS
instance ToXML RFC822 where toXML = toXMLText
instance ToXML ISO8601 where toXML = toXMLText
instance ToXML AWSTime where toXML = toXMLText
instance ToXML BasicTime where toXML = toXMLText
instance ToXML POSIX where toXML = toXMLText
instance ToJSON RFC822 where toJSON = toJSONText
instance ToJSON ISO8601 where toJSON = toJSONText
instance ToJSON AWSTime where toJSON = toJSONText
instance ToJSON BasicTime where toJSON = toJSONText
instance ToJSON POSIX where toJSON = toJSONText