module Handler.Exam.List
  ( mkExamTable
  , getCExamListR
  ) where

import Import

import Handler.Utils

import qualified Data.Map as Map

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E


mkExamTable :: Entity Course -> DB (Any, Widget)
mkExamTable (Entity cid Course{..}) = do
  let tid = courseTerm
      ssh = courseSchool
      csh = courseShorthand
  now <- liftIO getCurrentTime
  mbAid <- maybeAuthId
  mayCreate <- hasWriteAccessTo $ CourseR tid ssh csh CExamNewR

  let
    examDBTable = DBTable{..}
      where
        dbtSQLQuery exam = do
          E.where_ $ exam E.^. ExamCourse E.==. E.val cid
          return exam
        dbtRowKey = (E.^. ExamId)
        dbtProj = return
        dbtColonnade = dbColonnade . mconcat $ catMaybes
          [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) examName
          , (<$ guard mayCreate) . sortable (Just "visible") (i18nCell MsgExamVisibleFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty (dateTimeCellVisible now) examVisibleFrom
          , Just . sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
          , Just . sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
          , Just . sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
          , Just . sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
              mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
              isRegistered <- case mbAid of
                Nothing  -> return False
                Just uid -> existsBy $ UniqueExamRegistration eId uid
              let label   = bool MsgExamNotRegistered MsgExamRegistered isRegistered
                  examUrl = CExamR tid ssh csh examName EShowR
              if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
                 | otherwise   -> return [whamlet|_{label}|]
          ]
        dbtSorting = Map.fromList
          [ ("name", SortColumn $ \exam -> exam E.^. ExamName )
          , ("time", SortColumn $ \exam -> exam E.^. ExamStart )
          , ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
          , ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
          , ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
          , ("registered", SortColumn $ \exam ->
              case mbAid of
                Nothing -> E.false
                Just uid ->
                  E.exists $ E.from $ \reg -> do
                    E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid
                    E.where_ $ reg E.^. ExamRegistrationExam E.==. exam E.^. ExamId
            )
          ]
        dbtFilter = singletonMap "may-read" . FilterProjected $
          \(Any b) DBRow{ dbrOutput = Entity _ Exam{..} }
           -> (== b) <$> hasReadAccessTo (CExamR tid ssh csh examName EShowR) :: DB Bool
        dbtFilterUI = const mempty
        dbtStyle = def
        dbtParams = def
        dbtIdent :: Text
        dbtIdent = "exams"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing

    examDBTableValidator = def
      & defaultSorting [SortAscBy "time"]
      & forceFilter "may-read" (Any True)

  dbTable examDBTableValidator examDBTable


getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCExamListR tid ssh csh = do
  examTable <- runDB $ do
    c <- getBy404 $ TermSchoolCourseShort tid ssh csh
    view _2 <$> mkExamTable c

  siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamsHeading) $ do
    setTitleI $ prependCourseTitle tid ssh csh MsgExamsHeading
    $(widgetFile "exam-list")