module Handler.Sheet.List
  ( getSheetListR
  ) where

import Import hiding (link)

import Utils.Sheet
import Handler.Utils
import Handler.Utils.SheetType

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

import qualified Data.Map as Map


getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getSheetListR tid ssh csh = do
  muid <- maybeAuthId
  now <- liftIO getCurrentTime
  cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
  let
    hasSFT :: (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool) -> [SheetFileType]
    hasSFT (E.Value hasExercise, E.Value hasHint, E.Value hasSolution, E.Value hasMarking)
      = [ sft | sft <- universeF
              , sft /= SheetExercise || hasExercise
              , sft /= SheetHint     || hasHint
              , sft /= SheetSolution || hasSolution
              , sft /= SheetMarking  || hasMarking
        ]
    lastSheetEdit sheet = E.subSelectMaybe . E.from $ \sheetEdit -> do
        E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
        return . E.max_ $ sheetEdit E.^. SheetEditTime

    sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionUser))) -> E.SqlQuery ()
    sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do
      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
      E.on $  E.just (sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid

    querySubmission :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionUser))) -> E.SqlExpr (Maybe (Entity Submission))
    querySubmission (_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) = submission

    sheetFilter :: SheetName -> DB Bool
    sheetFilter sheetName = hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR

    sheetCol = widgetColonnade . mconcat $
      [ -- dbRow ,
        sortable (Just "name") (i18nCell MsgTableSheet)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) sheetName
      , sortable (Just "last-edit") (i18nCell MsgTableLastEdit)
          $ \DBRow{dbrOutput=(_, E.Value mEditTime, _, _)} -> foldMap dateTimeCell mEditTime
      , sortable (Just "visible-from") (i18nCell MsgSheetAccessibleSince)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom
      , sortable (toNothing "downloads") (i18nCell MsgFiles)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> listCell
              [ icnCell & addIconFixedWidth
              | let existingSFTs = hasSFT existFiles
              , sft <- [minBound..maxBound]
              , let link = CSheetR tid ssh csh sheetName $ SZipR sft
              , let icn  = toWgt $ sheetFile2markup sft
              , let icnCell = if sft `elem` existingSFTs
                              then linkEitherCell link (icn, [whamlet|&emsp;|])
                              else spacerCell
              ] id & cellAttrs <>~ [("class","list--inline list--space-separated")]
      , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveFrom
      , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveTo
      , sortable Nothing (i18nCell MsgSheetSheetType) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> cell $ do
          sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
          tr <- getTranslate
          toWidget $ sheetTypeDesc tr
      , sortable Nothing (i18nCell MsgTableSubmission)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub, _)} -> case mbSub of
              Nothing -> mempty
              (Just (Entity sid Submission{})) ->
                let mkCid = encrypt sid -- TODO: executed twice
                    mkRoute = do
                      cid' <- mkCid
                      return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{cid2}|])
      , sortable (Just "rating") (i18nCell MsgTableRating)
          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} ->
            let stats = sheetTypeSum sheetType in -- for statistics over all shown rows
            case mbSub of
              Nothing -> cellTell mempty $ stats Nothing
              (Just (Entity sid sub@Submission{..})) ->
                let
                    mkRoute :: (MonadHandler m, HandlerSite m ~ UniWorX) => m (Route UniWorX)
                    mkRoute = liftHandler $ do
                      cid' <- encrypt sid
                      return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                    acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
                    tellStats = tell $ stats submissionRatingPoints
                in guardAuthCell ((, False) <$> mkRoute) $ acell & cellContents %~ (<* tellStats)

      , sortable Nothing -- (Just "percent")
                        (i18nCell MsgRatingPercent)
          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType, sheetName}, _, mbSub,_)} -> case mbSub of
              (Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) ->
                case preview (_grading . _maxPoints) sType of
                  Just maxPoints
                    | maxPoints /= 0 ->
                        let
                          mkRoute = liftHandler $ do
                            cid' <- encrypt sid
                            return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                        in guardAuthCell ((, False) <$> mkRoute) . cell $ do
                             toWidget . toMessage $ textPercent sPoints maxPoints
                  _other -> mempty
              _other -> mempty
      ]

    psValidator = def
      & defaultSorting [SortDescBy "submission-until", SortDescBy "submission-since"]
      & forceFilter "may-access" (Any True)

  (raw_statistics,table) <- runDB $ dbTableWidget psValidator DBTable
      { dbtColonnade = sheetCol
      , dbtSQLQuery  = \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> do
                          sheetData dt
                          let existFiles = -- check whether files exist for given type
                                ( hasSheetFileQuery sheet (E.val muid) SheetExercise
                                , hasSheetFileQuery sheet (E.val muid) SheetHint
                                , hasSheetFileQuery sheet (E.val muid) SheetSolution
                                , hasSheetFileQuery sheet (E.val muid) SheetMarking
                                )
                          return (sheet, lastSheetEdit sheet, submission, existFiles)
      , dbtRowKey = \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetId
      , dbtProj = dbtProjFilteredPostId
      , dbtSorting   = Map.fromList
        [ ( "name"
          , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
          )
        , ( "last-edit"
          , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> lastSheetEdit sheet
          )
        , ( "visible-from"
          , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetVisibleFrom
          )
        , ( "submission-since"
          , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom
          )
        , ( "submission-until"
          , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
          )
        , ( "rating"
          , SortColumn $ \(_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> submission E.?. SubmissionRatingPoints
          )
  --    GitLab Issue $143: HOW TO SORT?
  --       , ( "percent"
  --         , SortColumn $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
  --             case sheetType of -- no Haskell inside Esqueleto, right?
  --             (submission E.?. SubmissionRatingPoints) E./. (sheet E.^. SheetType)
  --         )
        ]
      , dbtFilter    = mconcat
        [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) DBRow{..} ->
            let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool))
             in (== b) <$> sheetFilter sheetName :: DB Bool
        , singletonMap "rated" . FilterColumn $ \(Any b) -> (E.==. E.val b) . E.isJust . (E.?. SubmissionRatingTime) . querySubmission
        , singletonMap "is-exam" . mkFilterProjectedPost $ \(Any b) DBRow{..} ->
            let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool))
             in return $ is _ExamPartPoints sheetType == b :: DB Bool
        ]
      , dbtFilterUI  = mconcat
        [ flip (prismAForm $ singletonFilter "is-exam" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSheetTypeIsExam)
        , flip (prismAForm $ singletonFilter "rated" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgIsRated)
        ]
      , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
      , dbtParams    = def
      , dbtIdent     = "sheets" :: Text
      , dbtCsvEncode = noCsvEncode
      , dbtCsvDecode = Nothing
      , dbtExtraReps = []
      }
    -- ) ( -- !!!DEPRECTAED!!! Summary only over shown rows !!!
    --   -- Collect summary over all Sheets, not just the ones shown due to pagination:
    --   do
    --     rows <- E.select $ E.from $ \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) ->
    --       sheetData dt *> return (sheet E.^. SheetName, sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
    --     flip filterM rows (\(E.Value sheetName, _, _) -> sheetFilter sheetName)
    -- )

  let statistics = gradeSummaryWidget MsgSheetGradingSummaryTitle raw_statistics -- only over shown rows
        -- foldMap (\(_, E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts))
  defaultLayout
    $(widgetFile "sheetList")
