module Taskell.Data.Date ( Day , Deadline(..) , Due(..) , timeToText , timeToDisplay , timeToOutput , timeToOutputLocal , textToTime , inputToTime , isoToTime , deadline ) where import ClassyPrelude import Control.Monad.Fail (MonadFail) import Data.Time.LocalTime (ZonedTime (ZonedTime)) import Data.Time.Zones (TZ, localTimeToUTCTZ, timeZoneForUTCTime, utcToLocalTimeTZ) import Data.Time.Calendar (diffDays) import Data.Time.Format (FormatTime, ParseTime, iso8601DateFormat) import Taskell.Data.Date.RelativeParser (parseRelative) import Taskell.Data.Date.Types (Deadline (..), Due (..)) -- formats dateFormat :: String dateFormat = "%Y-%m-%d" timeDisplayFormat :: String timeDisplayFormat = "%Y-%m-%d %H:%M" timeFormat :: String timeFormat = "%Y-%m-%d %H:%M %Z" isoFormat :: String isoFormat = iso8601DateFormat (Just "%H:%M:%S%Q%Z") -- utility functions utcToZonedTime :: TZ -> UTCTime -> ZonedTime utcToZonedTime tz time = ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time) appendYear :: (FormatTime t, FormatTime s) => String -> t -> s -> String appendYear txt t1 t2 = if format "%Y" t1 == format "%Y" t2 then txt else txt <> " %Y" -- output format :: (FormatTime t) => String -> t -> Text format fmt = pack . formatTime defaultTimeLocale fmt timeToText :: TZ -> UTCTime -> Due -> Text timeToText _ now (DueDate day) = format fmt day where fmt = appendYear "%d-%b" now day timeToText tz now (DueTime time) = format fmt local where local = utcToLocalTimeTZ tz time fmt = appendYear "%H:%M %d-%b" now local timeToDisplay :: TZ -> Due -> Text timeToDisplay _ (DueDate day) = format dateFormat day timeToDisplay tz (DueTime time) = format timeDisplayFormat (utcToLocalTimeTZ tz time) timeToOutput :: Due -> Text timeToOutput (DueDate day) = format dateFormat day timeToOutput (DueTime time) = format timeFormat time timeToOutputLocal :: TZ -> Due -> Text timeToOutputLocal _ (DueDate day) = format dateFormat day timeToOutputLocal tz (DueTime time) = format timeFormat (utcToZonedTime tz time) -- input parseT :: (Monad m, MonadFail m, ParseTime t) => String -> Text -> m t parseT fmt txt = parseTimeM False defaultTimeLocale fmt (unpack txt) parseDate :: Text -> Maybe Due parseDate txt = DueDate <$> parseT dateFormat txt () :: Maybe a -> Maybe a -> Maybe a () Nothing b = b () a _ = a textToTime :: Text -> Maybe Due textToTime txt = parseDate txt (DueTime <$> parseT timeFormat txt) inputToTime :: TZ -> UTCTime -> Text -> Maybe Due inputToTime tz now txt = parseDate txt (DueTime . localTimeToUTCTZ tz <$> parseT timeDisplayFormat txt) case parseRelative now txt of Right due -> Just due Left _ -> Nothing isoToTime :: Text -> Maybe Due isoToTime txt = DueTime <$> parseT isoFormat txt -- deadlines deadline :: UTCTime -> Due -> Deadline deadline now date | days < 0 = Passed | days == 0 = Today | days == 1 = Tomorrow | days < 7 = ThisWeek | otherwise = Plenty where days = case date of DueTime t -> diffDays (utctDay t) (utctDay now) DueDate d -> diffDays d (utctDay now)