{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Taskell.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, formatTime, iso8601DateFormat, parseTimeM)
import Data.Taskell.Date.RelativeParser (parseRelative)
import Data.Taskell.Date.Types (Deadline (..), Due (..))
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")
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"
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)
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
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)