module Handler.Utils
  ( module Handler.Utils
  ) where

import Import hiding (link)

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

import Handler.Utils.DateTime as Handler.Utils
import Handler.Utils.Form as Handler.Utils
import Handler.Utils.Table as Handler.Utils

import Handler.Utils.Zip        as Handler.Utils
import Handler.Utils.Rating     as Handler.Utils hiding (extractRatings)
-- import Handler.Utils.Submission as Handler.Utils
import Handler.Utils.Sheet      as Handler.Utils
import Handler.Utils.Mail       as Handler.Utils
import Handler.Utils.ContentDisposition as Handler.Utils
import Handler.Utils.I18n       as Handler.Utils
import Handler.Utils.Widgets    as Handler.Utils
import Handler.Utils.Database   as Handler.Utils
import Handler.Utils.Occurrences as Handler.Utils
import Handler.Utils.Memcached  as Handler.Utils hiding (manageMemcachedLocalInvalidations)
import Handler.Utils.Files      as Handler.Utils
import Handler.Utils.Download   as Handler.Utils
import Handler.Utils.AuthorshipStatement as Handler.Utils

import Handler.Utils.Term as Handler.Utils

import Control.Monad.Logger



-- | Prefix a message with a short course id,
--   eg. for window title bars, etc.
--   This function should help to make this consistent everywhere
prependCourseTitle :: (RenderMessage UniWorX msg) =>
  TermId -> SchoolId -> CourseShorthand -> msg -> UniWorXMessages
prependCourseTitle tid ssh csh msg = UniWorXMessages
  [ SomeMessage $ toPathPiece tid
  , SomeMessage dashText
  , SomeMessage $ toPathPiece ssh
  , SomeMessage dashText
  , SomeMessage csh
  , SomeMessage colonText
  , SomeMessage msg
  ]
 where
    dashText :: Text
    dashText = "-"

    colonText :: Text
    colonText = ":"

warnTermDays :: (RenderMessage UniWorX msg) => TermId -> Map UTCTime msg -> DB ()
warnTermDays tid timeNames = do
  Term{..} <- get404 tid
  MsgRenderer mr <- getMsgRenderer
  let alldays       = Map.keysSet timeNames
      warnholidays  = let hdays = Set.fromList termHolidays in
                      Set.filter (\(utctDay -> d) -> Set.member d hdays)                         alldays
      outoftermdays = Set.filter (\(utctDay -> d) -> d < termStart        || d > termEnd       ) alldays
      outoflecture  = Set.filter (\(utctDay -> d) -> d < termLectureStart || d > termLectureEnd) alldays
                        `Set.difference` outoftermdays -- out of term implies out of lecture-time
      warnI msg d   = formatTime SelFormatDate d >>= \dt -> addMessageI Warning $ msg tid (mr (timeNames ! d)) dt
  forM_ warnholidays  $ warnI MsgDayIsAHoliday
  forM_ outoflecture  $ warnI MsgDayIsOutOfLecture
  forM_ outoftermdays $ warnI MsgDayIsOutOfTerm


-- | return a value only if the current user ist authorized for a given route
guardAuthorizedFor :: ( MonadThrow m
                      , MonadTrans t, MonadPlus (t (ReaderT SqlBackend m))
                      , MonadAP (ReaderT SqlBackend m)
                      )
                   => Route UniWorX -> a -> t (ReaderT SqlBackend m) a
guardAuthorizedFor link = guardMOn . lift $ hasReadAccessTo link


runAppLoggingT :: UniWorX -> LoggingT m a -> m a
runAppLoggingT app@(appLogger -> (_, loggerTVar)) = flip runLoggingT logFunc
  where
    logFunc loc src lvl str = do
      f <- messageLoggerSource app <$> readTVarIO loggerTVar
      f loc src lvl str

studyFeaturesWidget :: StudyFeaturesId -> Widget
studyFeaturesWidget featId = do
  (StudyFeatures{studyFeaturesSemester}, (degree, terms)) <- liftHandler . runDB . ($ featId) . runKleisli $ Kleisli getJust >>> Kleisli return &&& Kleisli (getJust . studyFeaturesDegree) &&& Kleisli (getJust . studyFeaturesField)
  [whamlet|
    $newline never
    _{StudyDegreeTerm degree terms}, _{MsgTableStudyFeatureAge} #{studyFeaturesSemester}
  |]


getShowSex :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool
getShowSex = maybe False (userShowSex . entityVal) <$> maybeAuth


-- | Conditional redirect that hides the URL if the user is not authorized for the route
redirectAccess :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
redirectAccess url = liftHandler $ do
  -- must hide URL if not authorized
  access <- isAuthorized url False
  case access of
    Authorized -> redirect url
    _          -> permissionDeniedI MsgUnauthorizedRedirect

redirectAccessWith :: (MonadHandler m, HandlerSite m ~ UniWorX) => Status -> Route (HandlerSite m) -> m a
redirectAccessWith status url = liftHandler $ do
  -- must hide URL if not authorized
  access <- isAuthorized url False
  case access of
    Authorized -> redirectWith status url
    _          -> permissionDeniedI MsgUnauthorizedRedirect

redirectAlternatives :: (MonadHandler m, HandlerSite m ~ UniWorX) => NonEmpty (Route (HandlerSite m)) -> m a
redirectAlternatives = go
  where
    go (nunsnoc -> ([], r)) = redirectAccess r
    go (nunsnoc -> (r' : rs, r)) = liftHandler $ do
      access <- isAuthorized r' False
      case access of
        Authorized -> redirect r'
        _          -> redirectAlternatives (nsnoc rs r)

    nunsnoc (x :| xs) = case nonEmpty xs of
      Nothing  -> ([], x)
      Just xs' -> over _1 (x :) $ nunsnoc xs'
    nsnoc [] x = x :| []
    nsnoc (x' : xs) x = x' :| (xs ++ [x])