module Data.HodaTime.TimeZone.Internal ( TZIdentifier(..) ,TransitionInfo(..) ,TransitionExpression(..) ,TransitionExpressionInfo(..) ,UtcTransitionsMap ,IntervalEntry(..) ,CalDateTransitionsMap ,TimeZone(..) ,emptyUtcTransitions ,addUtcTransition ,addUtcTransitionExpression ,activeTransitionFor ,nextTransition ,emptyCalDateTransitions ,addCalDateTransition ,addCalDateTransitionExpression ,calDateTransitionsFor ,aroundCalDateTransition ,fixedOffsetZone ,expressionToInstant ,yearExpressionToInstant ) where import Data.Maybe (fromMaybe) import Data.HodaTime.Instant.Internal (Instant(..), minus, bigBang) import Data.HodaTime.Offset.Internal (Offset(..), adjustInstant) import Data.HodaTime.Duration.Internal (fromNanoseconds) import Data.HodaTime.Calendar.Gregorian.Internal (nthDayToDayOfMonth, yearMonthDayToDays, instantToYearMonthDay) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.IntervalMap.FingerTree (IntervalMap, Interval(..)) import qualified Data.IntervalMap.FingerTree as IMap data TZIdentifier = UTC | Zone String deriving (Eq, Show) data TransitionInfo = TransitionInfo { tiUtcOffset :: Offset, tiIsDst :: Bool, tiAbbreviation :: String } deriving (Eq, Show) data TransitionExpression = NthDayExpression { teMonth :: Int ,teNthDay :: Int ,teDay :: Int ,teSeconds :: Int } | JulianExpression { jeCountLeaps :: Bool, jeDay :: Int, jeSeconds :: Int } deriving (Eq, Show) data TransitionExpressionInfo = TransitionExpressionInfo { startExpression :: TransitionExpression ,endExpression :: TransitionExpression ,stdTransInfo :: TransitionInfo ,dstTransInfo :: TransitionInfo } deriving (Eq, Show) data TransitionInfoOrExp = TransitionInfoFixed TransitionInfo | TransitionInfoExpression TransitionExpressionInfo deriving (Eq, Show) -- UTC instant to transition type UtcTransitionsMap = Map Instant TransitionInfoOrExp emptyUtcTransitions :: UtcTransitionsMap emptyUtcTransitions = Map.empty addUtcTransition :: Instant -> TransitionInfo -> UtcTransitionsMap -> UtcTransitionsMap addUtcTransition i fti = Map.insert i (TransitionInfoFixed fti) addUtcTransitionExpression :: Instant -> TransitionExpressionInfo -> UtcTransitionsMap -> UtcTransitionsMap addUtcTransitionExpression i texp = Map.insert i (TransitionInfoExpression texp) activeTransitionFor :: Instant -> TimeZone -> TransitionInfo activeTransitionFor i (TimeZone _ utcM _) = fromTransInfo i f id . snd . fromMaybe (Map.findMin utcM) $ Map.lookupLE i utcM -- NOTE: The findMin case should be impossible where f (dstStart, dstEnd, stdTI, dstTI) = if i <= dstStart || i >= dstEnd then stdTI else dstTI -- TODO: We would need to get the next year to complete this function but let's see if it's actually used before doing more work nextTransition :: Instant -> TimeZone -> (Instant, TransitionInfo) nextTransition i (TimeZone _ utcM _) = f . fromMaybe (Map.findMax utcM) $ Map.lookupGT i utcM where f (i', ti) = fromTransInfo i g (\ti' -> (i', ti')) ti g (dstStart, dstEnd, stdTI, dstTI) = if i < dstStart then (dstStart, dstTI) else if i < dstEnd then (dstEnd, stdTI) else error "nextTransition: need next year" -- CalendarDate to transition data IntervalEntry a = Smallest | Entry a | Largest deriving (Eq, Ord, Show) type CalDateTransitionsMap = IntervalMap (IntervalEntry Instant) TransitionInfoOrExp emptyCalDateTransitions :: CalDateTransitionsMap emptyCalDateTransitions = IMap.empty addCalDateTransition :: IntervalEntry Instant -> IntervalEntry Instant -> TransitionInfo -> CalDateTransitionsMap -> CalDateTransitionsMap addCalDateTransition b e fti = IMap.insert interval (TransitionInfoFixed fti) where interval = Interval b e addCalDateTransitionExpression :: IntervalEntry Instant -> IntervalEntry Instant -> TransitionExpressionInfo -> CalDateTransitionsMap -> CalDateTransitionsMap addCalDateTransitionExpression b e texp = IMap.insert interval (TransitionInfoExpression texp) where interval = Interval b e calDateTransitionsFor :: Instant -> TimeZone -> [TransitionInfo] calDateTransitionsFor i (TimeZone _ _ cdtMap) = concatMap (fromTransInfo i f (:[]) . snd) . search $ cdtMap where search = IMap.search (Entry i) f = fmap snd . search . buildFixedTransIMap -- TODO: this function need major cleanup, this implementation is really nasty and almost certainly unsafe aroundCalDateTransition :: Instant -> TimeZone -> (TransitionInfo, TransitionInfo) aroundCalDateTransition i (TimeZone _ _ cdtMap) = go . fmap snd . IMap.search (Entry i) $ cdtMap where go [] = (before, after) go [(TransitionInfoExpression (TransitionExpressionInfo _ _ stdTI dstTI))] = (stdTI, dstTI) -- NOTE: Should be the only way this happens go x = error $ "aroundCalDateTransition: unexpected search result" ++ show x before = fromTransInfo i bomb id . snd . go' . flip IMap.search cdtMap . IMap.high . fromMaybe (error "around.before: fixme") . IMap.bounds $ front after = fromTransInfo i bomb id . snd . fst . fromMaybe (error "around.after: fixme") . IMap.leastView $ back (front, back) = IMap.splitAfter (Entry i) cdtMap go' [] = error "aroundCalDateTransition: no before transitions" go' [tei] = tei go' _ = error "aroundCalDateTransition: too many before transitions" bomb = error "aroundCalDateTransition: got expression when fixed expected" -- | Represents a time zone. A 'TimeZone' can be used to instanciate a 'ZoneDateTime' from either and 'Instant' or a 'CalendarDateTime' data TimeZone = TimeZone { zoneName :: TZIdentifier ,utcTransitionsMap :: UtcTransitionsMap ,calDateTransitionsMap :: CalDateTransitionsMap } deriving (Eq, Show) -- constructors fixedOffsetZone :: String -> Offset -> (UtcTransitionsMap, CalDateTransitionsMap, TransitionInfo) fixedOffsetZone tzName offset = (utcM, calDateM, tInfo) where utcM = addUtcTransition bigBang tInfo emptyUtcTransitions calDateM = addCalDateTransition Smallest Largest tInfo emptyCalDateTransitions tInfo = TransitionInfo offset False tzName -- helper functions fromTransInfo :: Instant -> ((Instant, Instant, TransitionInfo, TransitionInfo) -> a) -> (TransitionInfo -> a) -> TransitionInfoOrExp -> a fromTransInfo _ _ f (TransitionInfoFixed ti) = f ti fromTransInfo i f _ (TransitionInfoExpression (TransitionExpressionInfo startExpr endExpr stdTI dstTI)) = f (dstStart, dstEnd, stdTI, dstTI) where dstStart = expressionToInstant i startExpr dstEnd = expressionToInstant i endExpr -- NOTE: We have to store expressions in the year they take effect so this is the first place we can resolve -- the actual map. Otherwise we'd have to create two per year buildFixedTransIMap :: (Instant, Instant, TransitionInfo, TransitionInfo) -> IntervalMap (IntervalEntry Instant) TransitionInfo buildFixedTransIMap (start, end, stdTI, dstTI) = mkMap entries mempty where mkMap [] m = m mkMap ((b, e, ti):xs) m = mkMap xs $ addEntry b e ti m addEntry b e ti = IMap.insert (Interval b e) ti entries = [(Smallest, Entry beforeStart, stdTI), (Entry start', Entry beforeEnd, dstTI), (Entry end', Largest, stdTI)] (start', beforeStart) = adjust start dstTI stdTI (end', beforeEnd) = adjust end stdTI dstTI adjust tran ti prevTI = (x, beforeX) where x = adjustInstant (tiUtcOffset ti) tran beforeX = flip minus (fromNanoseconds 1) . adjustInstant (tiUtcOffset prevTI) $ tran expressionToInstant :: Instant -> TransitionExpression -> Instant expressionToInstant instant = yearExpressionToInstant y where y = let (yr, _, _) = instantToYearMonthDay instant in fromIntegral yr yearExpressionToInstant :: Int -> TransitionExpression -> Instant yearExpressionToInstant y = go where go (NthDayExpression m nth day s) = Instant days' (fromIntegral s) 0 where m' = toEnum m d = nthDayToDayOfMonth nth day m' y days' = fromIntegral $ yearMonthDayToDays y m' d go (JulianExpression _cly _d _s) = error "need julian year day function"