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 :: String
dateFormat = String
"%Y-%m-%d"

timeDisplayFormat :: String
timeDisplayFormat :: String
timeDisplayFormat = String
"%Y-%m-%d %H:%M"

timeFormat :: String
timeFormat :: String
timeFormat = String
"%Y-%m-%d %H:%M %Z"

isoFormat :: String
isoFormat :: String
isoFormat = Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%S%Q%Z")

-- utility functions
utcToZonedTime :: TZ -> UTCTime -> ZonedTime
utcToZonedTime :: TZ -> UTCTime -> ZonedTime
utcToZonedTime TZ
tz UTCTime
time = LocalTime -> TimeZone -> ZonedTime
ZonedTime (TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
tz UTCTime
time) (TZ -> UTCTime -> TimeZone
timeZoneForUTCTime TZ
tz UTCTime
time)

appendYear :: (FormatTime t, FormatTime s) => String -> t -> s -> String
appendYear :: String -> t -> s -> String
appendYear String
txt t
t1 s
t2 =
    if String -> t -> Text
forall t. FormatTime t => String -> t -> Text
format String
"%Y" t
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> s -> Text
forall t. FormatTime t => String -> t -> Text
format String
"%Y" s
t2
        then String
txt
        else String
txt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" %Y"

-- output
format :: (FormatTime t) => String -> t -> Text
format :: String -> t -> Text
format String
fmt = String -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack (String -> Text) -> (t -> String) -> t -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt

timeToText :: TZ -> UTCTime -> Due -> Text
timeToText :: TZ -> UTCTime -> Due -> Text
timeToText TZ
_ UTCTime
now (DueDate Day
day) = String -> Day -> Text
forall t. FormatTime t => String -> t -> Text
format String
fmt Day
day
  where
    fmt :: String
fmt = String -> UTCTime -> Day -> String
forall t s.
(FormatTime t, FormatTime s) =>
String -> t -> s -> String
appendYear String
"%d-%b" UTCTime
now Day
day
timeToText TZ
tz UTCTime
now (DueTime UTCTime
time) = String -> LocalTime -> Text
forall t. FormatTime t => String -> t -> Text
format String
fmt LocalTime
local
  where
    local :: LocalTime
local = TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
tz UTCTime
time
    fmt :: String
fmt = String -> UTCTime -> LocalTime -> String
forall t s.
(FormatTime t, FormatTime s) =>
String -> t -> s -> String
appendYear String
"%H:%M %d-%b" UTCTime
now LocalTime
local

timeToDisplay :: TZ -> Due -> Text
timeToDisplay :: TZ -> Due -> Text
timeToDisplay TZ
_ (DueDate Day
day)   = String -> Day -> Text
forall t. FormatTime t => String -> t -> Text
format String
dateFormat Day
day
timeToDisplay TZ
tz (DueTime UTCTime
time) = String -> LocalTime -> Text
forall t. FormatTime t => String -> t -> Text
format String
timeDisplayFormat (TZ -> UTCTime -> LocalTime
utcToLocalTimeTZ TZ
tz UTCTime
time)

timeToOutput :: Due -> Text
timeToOutput :: Due -> Text
timeToOutput (DueDate Day
day)  = String -> Day -> Text
forall t. FormatTime t => String -> t -> Text
format String
dateFormat Day
day
timeToOutput (DueTime UTCTime
time) = String -> UTCTime -> Text
forall t. FormatTime t => String -> t -> Text
format String
timeFormat UTCTime
time

timeToOutputLocal :: TZ -> Due -> Text
timeToOutputLocal :: TZ -> Due -> Text
timeToOutputLocal TZ
_ (DueDate Day
day)   = String -> Day -> Text
forall t. FormatTime t => String -> t -> Text
format String
dateFormat Day
day
timeToOutputLocal TZ
tz (DueTime UTCTime
time) = String -> ZonedTime -> Text
forall t. FormatTime t => String -> t -> Text
format String
timeFormat (TZ -> UTCTime -> ZonedTime
utcToZonedTime TZ
tz UTCTime
time)

-- input
parseT :: (Monad m, MonadFail m, ParseTime t) => String -> Text -> m t
parseT :: String -> Text -> m t
parseT String
fmt Text
txt = Bool -> TimeLocale -> String -> String -> m t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
fmt (Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
txt)

parseDate :: Text -> Maybe Due
parseDate :: Text -> Maybe Due
parseDate Text
txt = Day -> Due
DueDate (Day -> Due) -> Maybe Day -> Maybe Due
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> Maybe Day
forall (m :: * -> *) t.
(Monad m, MonadFail m, ParseTime t) =>
String -> Text -> m t
parseT String
dateFormat Text
txt

(<?>) :: Maybe a -> Maybe a -> Maybe a
<?> :: Maybe a -> Maybe a -> Maybe a
(<?>) Maybe a
Nothing Maybe a
b = Maybe a
b
(<?>) Maybe a
a Maybe a
_       = Maybe a
a

textToTime :: Text -> Maybe Due
textToTime :: Text -> Maybe Due
textToTime Text
txt = Text -> Maybe Due
parseDate Text
txt Maybe Due -> Maybe Due -> Maybe Due
forall a. Maybe a -> Maybe a -> Maybe a
<?> (UTCTime -> Due
DueTime (UTCTime -> Due) -> Maybe UTCTime -> Maybe Due
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> Maybe UTCTime
forall (m :: * -> *) t.
(Monad m, MonadFail m, ParseTime t) =>
String -> Text -> m t
parseT String
timeFormat Text
txt)

inputToTime :: TZ -> UTCTime -> Text -> Maybe Due
inputToTime :: TZ -> UTCTime -> Text -> Maybe Due
inputToTime TZ
tz UTCTime
now Text
txt =
    Text -> Maybe Due
parseDate Text
txt Maybe Due -> Maybe Due -> Maybe Due
forall a. Maybe a -> Maybe a -> Maybe a
<?> (UTCTime -> Due
DueTime (UTCTime -> Due) -> (LocalTime -> UTCTime) -> LocalTime -> Due
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TZ -> LocalTime -> UTCTime
localTimeToUTCTZ TZ
tz (LocalTime -> Due) -> Maybe LocalTime -> Maybe Due
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> Maybe LocalTime
forall (m :: * -> *) t.
(Monad m, MonadFail m, ParseTime t) =>
String -> Text -> m t
parseT String
timeDisplayFormat Text
txt) Maybe Due -> Maybe Due -> Maybe Due
forall a. Maybe a -> Maybe a -> Maybe a
<?>
    case UTCTime -> Text -> Either Text Due
parseRelative UTCTime
now Text
txt of
        Right Due
due -> Due -> Maybe Due
forall a. a -> Maybe a
Just Due
due
        Left Text
_    -> Maybe Due
forall a. Maybe a
Nothing

isoToTime :: Text -> Maybe Due
isoToTime :: Text -> Maybe Due
isoToTime Text
txt = UTCTime -> Due
DueTime (UTCTime -> Due) -> Maybe UTCTime -> Maybe Due
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> Maybe UTCTime
forall (m :: * -> *) t.
(Monad m, MonadFail m, ParseTime t) =>
String -> Text -> m t
parseT String
isoFormat Text
txt

-- deadlines
deadline :: UTCTime -> Due -> Deadline
deadline :: UTCTime -> Due -> Deadline
deadline UTCTime
now Due
date
    | Integer
days Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Deadline
Passed
    | Integer
days Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Deadline
Today
    | Integer
days Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Deadline
Tomorrow
    | Integer
days Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
7 = Deadline
ThisWeek
    | Bool
otherwise = Deadline
Plenty
  where
    days :: Integer
days =
        case Due
date of
            DueTime UTCTime
t -> Day -> Day -> Integer
diffDays (UTCTime -> Day
utctDay UTCTime
t) (UTCTime -> Day
utctDay UTCTime
now)
            DueDate Day
d -> Day -> Day -> Integer
diffDays Day
d (UTCTime -> Day
utctDay UTCTime
now)