module Handler.Tutorial.List
  ( getCTutorialListR
  ) where

import Import
import Handler.Utils
import Handler.Utils.Tutorial

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

import qualified Data.Map as Map

import qualified Data.CaseInsensitive as CI


getCTutorialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCTutorialListR tid ssh csh = do
  muid <- maybeAuthId
  cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
  MsgRenderer mr <- getMsgRenderer

  let
    tutorialDBTable = DBTable{..}
      where
        resultTutorial :: Lens' (DBRow (Entity Tutorial, Int, Bool)) (Entity Tutorial)
        resultTutorial = _dbrOutput . _1
        resultParticipants = _dbrOutput . _2
        resultShowRoom = _dbrOutput . _3
        
        dbtSQLQuery tutorial = do
          E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
          let participants :: E.SqlExpr (E.Value Int)
              participants = E.subSelectCount . E.from $ \tutorialParticipant ->
                E.where_ $ tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
          let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) muid
                   E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
          return (tutorial, participants, showRoom)
        dbtRowKey = (E.^. TutorialId)
        dbtProj = over (_dbrOutput . _2) E.unValue . over (_dbrOutput . _3) E.unValue <$> dbtProjId
        dbtColonnade = dbColonnade $ mconcat
          [ sortable (Just "type") (i18nCell MsgTutorialType) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> textCell $ CI.original tutorialType
          , sortable (Just "name") (i18nCell MsgTutorialName) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) [whamlet|#{tutorialName}|]
          , sortable Nothing (i18nCell MsgTutorialTutors) $ \(view $ resultTutorial . _entityKey -> tutid) -> sqlCell $ do
              tutors <- fmap (map $(unValueN 3)) . E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
                E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
                E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
                return (user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname)
              return [whamlet|
                       $newline never
                       <ul .list--iconless .list--inline .list--comma-separated>
                         $forall tutor <- tutors
                           <li>
                             ^{nameEmailWidget' tutor}
                     |]
          , sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \(view $ $(multifocusL 2) (resultTutorial . _entityVal) resultParticipants -> (Tutorial{..}, n)) -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) $ tshow n
          , sortable (Just "capacity") (i18nCell MsgTutorialCapacity) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . tshow) tutorialCapacity
          , sortable (Just "room") (i18nCell MsgTutorialRoom) $ \res -> if
              | res ^. resultShowRoom -> maybe (i18nCell MsgTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
              | otherwise -> i18nCell MsgTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
          , sortable Nothing (i18nCell MsgTutorialTime) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> occurrencesCell tutorialTime
          , sortable (Just "register-group") (i18nCell MsgTutorialRegGroup) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . CI.original) tutorialRegGroup
          , sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterFrom
          , sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterTo
          , sortable (Just "deregister-until") (i18nCell MsgTutorialDeregisterUntil) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialDeregisterUntil
          , sortable Nothing (mempty & cellAttrs <>~ pure ("uw-hide-columns--hider-label", mr MsgActionsHead)) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> cell $ do
              linkButton mempty [whamlet|_{MsgTutorialEdit}|] [BCIsButton] . SomeRoute $ CTutorialR tid ssh csh tutorialName TEditR
              linkButton mempty [whamlet|_{MsgTutorialDelete}|] [BCIsButton, BCDanger] . SomeRoute $ CTutorialR tid ssh csh tutorialName TDeleteR
          ]
        dbtSorting = Map.fromList
          [ ("type", SortColumn $ \tutorial -> tutorial E.^. TutorialType )
          , ("name", SortColumn $ \tutorial -> tutorial E.^. TutorialName )
          , ("participants", SortColumn $ \tutorial -> let participantCount :: E.SqlExpr (E.Value Int)
                                                           participantCount = E.subSelectCount . E.from $ \tutorialParticipant ->
                                                             E.where_ $ tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
                                                        in participantCount
            )
          , ("capacity", SortColumn $ \tutorial -> tutorial E.^. TutorialCapacity )
          , ("room", SortColumn $ \tutorial -> tutorial E.^. TutorialRoom )
          , ("register-group", SortColumn $ \tutorial -> tutorial E.^. TutorialRegGroup )
          , ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
          , ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo )
          , ("deregister-until", SortColumn $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )
          ]
        dbtFilter = Map.empty
        dbtFilterUI = const mempty
        dbtStyle = def
        dbtParams = def
        dbtIdent :: Text
        dbtIdent = "tutorials"
        dbtCsvEncode = noCsvEncode
        dbtCsvDecode = Nothing
        dbtExtraReps = []

    tutorialDBTableValidator = def
      & defaultSorting [SortAscBy "type", SortAscBy "name"]
  ((), tutorialTable) <- runDB $ dbTable tutorialDBTableValidator tutorialDBTable

  siteLayoutMsg (prependCourseTitle tid ssh csh MsgTutorialsHeading) $ do
    setTitleI $ prependCourseTitle tid ssh csh MsgTutorialsHeading
    $(widgetFile "tutorial-list")