{-# LANGUAGE NoImplicitPrelude
           , TemplateHaskell
           , OverloadedStrings
           , RecordWildCards
           , TypeFamilies
  #-}

module Handler.Utils.DateTime
  ( utcToLocalTime
  , localTimeToUTC, TZ.LocalToUTCResult(..)
  , formatTime'
  , formatTime
  , getTimeLocale, getDateTimeFormat
  , validDateTimeFormats, dateTimeFormatOptions
  ) where

import Import

import Data.Time.Zones hiding (localTimeToUTCFull)
import qualified Data.Time.Zones as TZ

import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime)
import qualified Data.Time.Format as Time

import Data.Set (Set)
import qualified Data.Set as Set

utcToLocalTime :: UTCTime -> LocalTime
utcToLocalTime = TZ.utcToLocalTimeTZ appTZ

localTimeToUTC :: LocalTime -> LocalToUTCResult
localTimeToUTC = TZ.localTimeToUTCFull appTZ

formatTime' :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX, IsString str) => String -> t -> m str
formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> pure fmtStr <*> pure t

class FormatTime t => HasLocalTime t where
  toLocalTime :: t -> LocalTime

instance HasLocalTime LocalTime where
  toLocalTime = id

instance HasLocalTime Day where
  toLocalTime d = toLocalTime $ UTCTime d 0

instance HasLocalTime UTCTime where
  toLocalTime t = utcToLocalTime t

-- formatTime :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX, IsString str) => (DateTimeFormat -> String) -> t -> m str
-- Restricted type for safety
formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => (DateTimeFormat -> String) -> t -> m Text
formatTime proj t = flip formatTime' (toLocalTime t) =<< (proj <$> getDateTimeFormat)

getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
getTimeLocale = getTimeLocale' <$> languages

getDateTimeFormat :: (MonadHandler m, HandlerSite m ~ UniWorX) => m DateTimeFormat
getDateTimeFormat = do
  mauth <- liftHandlerT maybeAuth
  let
    fmt
      | Just (Entity _ User{..}) <- mauth
      = userDateTimeFormat
      | otherwise
      = def
  return fmt

validDateTimeFormats :: Set DateTimeFormat
validDateTimeFormats = Set.fromList $
  [ DateTimeFormat "%a %d %b %Y %R" "%d.%m.%Y" "%R"
  , DateTimeFormat "%a %d %b %Y %T" "%d.%m.%Y" "%T"
  , DateTimeFormat "%a %d %b %Y %R" "%Y-%m-%d" "%R"
  , DateTimeFormat "%a %d %b %Y %T" "%Y-%m-%d" "%T"
  ]

dateTimeFormatOptions :: (MonadHandler m, HandlerSite m ~ UniWorX) => m (OptionList DateTimeFormat)
dateTimeFormatOptions = do
  now <- liftIO getCurrentTime

  let
    toOption fmt@DateTimeFormat{..} = do
      dateTime <- formatTime' dateTimeFormat now
      date <- formatTime' dateFormat now
      time <- formatTime' timeFormat now
      return $ (MsgDateTimeFormatOption dateTime date time, fmt)
  
  optionsPairs <=< mapM toOption $ Set.toList validDateTimeFormats