{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HerfTime.ZonedTime ( HerfZonedTime
, toZonedTime
, fromZonedTime
, addTimeZone
, herfz
, reherfz
, module HerfTime
, module Data.Time) where
import Control.Applicative ((<|>))
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.Time
import GHC.TypeLits
import HerfTime
newtype HerfZonedTime (z::Symbol) = HerfZonedTime {_unherfZonedTime :: ZonedTime}
deriving (FormatTime,ParseTime)
instance (KnownSymbol z) => Show (HerfZonedTime z) where
show = herfShow
addTimeZone :: forall z. (KnownSymbol z) => UTCTime -> HerfZonedTime z
addTimeZone (UTCTime day' diffTime') = HerfZonedTime zonedTime
where
zonedTime = ZonedTime localTime timeZone
localTime = LocalTime day' (timeToTimeOfDay diffTime')
pz = Proxy :: Proxy z
v = symbolVal pz
timeZone :: TimeZone
timeZone = case (parseTimeM True defaultTimeLocale "%Z" v ) of
Just t -> t
Nothing -> fromMaybe (error $ "time zone broken " ++ v) (parseTimeM True defaultTimeLocale "%z" v)
toZonedTime :: forall z . (KnownSymbol z) => UTCTime -> HerfZonedTime z
toZonedTime time' = HerfZonedTime $ utcToZonedTime (fromMaybe utc . tz $ directSymbolVal) time'
where
pz = Proxy :: Proxy z
directSymbolVal = symbolVal pz
tz :: String -> Maybe TimeZone
tz v = (parseTimeM True defaultTimeLocale "%Z" v ) <|>
(parseTimeM True defaultTimeLocale "%z" v)
fromZonedTime :: forall z . (KnownSymbol z) => HerfZonedTime z -> UTCTime
fromZonedTime (HerfZonedTime time') = zonedTimeToUTC time'
instance (KnownSymbol z) => ToUTCHerfTime (HerfZonedTime z) where
herf = herf . fromZonedTime
instance (KnownSymbol z) => FromUTCHerfTime (HerfZonedTime z) where
unherf = toZonedTime . unherf
instance (KnownSymbol z) => HerfedTime (HerfZonedTime z) where
addYear a y = unherf $ herf a `add` y
addMonth a m = unherf $ herf a `add` m
addWeek a w = unherf $ herf a `add` w
addDay a d = unherf $ herf a `add` d
addHour a h = unherf $ herf a `add` h
addMinute a i = unherf $ herf a `add` i
addSecond a s = unherf $ herf a `add` s
addPicosecond a p = unherf $ herf a `add` p
date y m d = toZonedTime $ date y m d
dateTime y m d h i s = addTimeZone $ dateTime y m d h i s
dateTimePico y m d h i s p = addTimeZone $ dateTimePico y m d h i s p
herfz :: ZonedTime -> UTCHerfTime
herfz = herf . zonedTimeToUTC
reherfz :: FromUTCHerfTime b => ZonedTime -> b
reherfz = unherf . herfz