{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.ExamOffice.Exams
  ( getEOExamsR, postEOExamsR
  ) where

import Import

import Handler.Utils
import qualified Handler.Utils.ExamOffice.Exam as Exam
import qualified Handler.Utils.ExamOffice.ExternalExam as ExternalExam

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

import qualified Colonnade

import qualified Data.Conduit.Combinators as C
import qualified Data.Map as Map
import qualified Data.Set as Set


data ExamAction = ExamSetLabel | ExamRemoveLabel
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''ExamAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ExamAction id

data ExamActionData = ExamSetLabelData
                        { easlNewLabel :: ExamOfficeLabelId
                        }
                    | ExamRemoveLabelData
  deriving (Eq, Ord, Read, Show, Generic, Typeable)


data ExamsTableFilterProj = ExamsTableFilterProj
  { etProjFilterMayAccess  :: Maybe Bool
  , etProjFilterHasResults :: Maybe Bool
  , etProjFilterLabel      :: Maybe (Either ExamOfficeExternalExamLabelId ExamOfficeExamLabelId)
  , etProjFilterIsSynced   :: Maybe Bool
  }

instance Default ExamsTableFilterProj where
  def = ExamsTableFilterProj
    { etProjFilterMayAccess  = Nothing
    , etProjFilterHasResults = Nothing
    , etProjFilterLabel      = Nothing
    , etProjFilterIsSynced   = Nothing
    }

makeLenses_ ''ExamsTableFilterProj


type ExamsTableExpr = ( (               E.SqlExpr (Maybe (Entity Exam  ))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity School))
                        )
                        `E.LeftOuterJoin`
                        (               E.SqlExpr (Maybe (Entity ExamOfficeExamLabel))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeLabel))
                        )
                      )
    `E.FullOuterJoin` ( E.SqlExpr (Maybe (Entity ExternalExam))
                        `E.LeftOuterJoin`
                        (               E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity ExamOfficeLabel))
                        )
                      )

type ExamsTableData = DBRow ( Either
                              ( Entity ExternalExam
                              , Maybe (Entity ExamOfficeLabel)
                              )
                              ( Entity Exam
                              , Entity Course
                              , Entity School
                              , Maybe (Entity ExamOfficeLabel)
                              )
                            , Maybe Natural
                            , Maybe Natural
                            )

queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam)))
queryExam = to $ $(E.sqlIJproj 3 1) . $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 1)

queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
queryCourse = to $ $(E.sqlIJproj 3 2) . $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 1)
  
querySchool :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity School)))
querySchool = to $ $(E.sqlIJproj 3 3) . $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 1)

queryExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExamLabel)))
queryExamLabel = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 1)

queryLabelExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeLabel)))
queryLabelExam = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 1)

queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
queryExternalExam = to $ $(E.sqlLOJproj 2 1) . $(E.sqlFOJproj 2 2)

queryExternalExamLabel :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeExternalExamLabel)))
queryExternalExamLabel = to $ $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 2)

queryLabelExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExamOfficeLabel)))
queryLabelExternalExam = to $ $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) . $(E.sqlFOJproj 2 2)

resultExam :: Traversal' ExamsTableData (Entity Exam)
resultExam = _dbrOutput . _1 . _Right . _1

resultCourse :: Traversal' ExamsTableData (Entity Course)
resultCourse = _dbrOutput . _1 . _Right . _2

resultSchool :: Traversal' ExamsTableData (Entity School)
resultSchool = _dbrOutput . _1 . _Right . _3

resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
resultExternalExam = _dbrOutput . _1 . _Left . _1

resultLabel :: Traversal' ExamsTableData (Maybe (Entity ExamOfficeLabel))
resultLabel = _dbrOutput . _1 . choosing _2 _4

resultSynchronised, resultResults :: Lens' ExamsTableData (Maybe Natural)
resultSynchronised = _dbrOutput . _2
resultResults = _dbrOutput . _3

resultIsSynced :: Getter ExamsTableData Bool
resultIsSynced = to $ (>=) <$> view resultSynchronised <*> view resultResults


-- | List of all exams where the current user may (in their function as exam-office) access users grades
getEOExamsR, postEOExamsR :: Handler Html
getEOExamsR = postEOExamsR
postEOExamsR = do
  (uid, User{..}) <- requireAuthPair
  now <- liftIO getCurrentTime
  mr <- getMessageRender

  getSynced <- lookupGetParam "synced" <&>
    (\case
      Just "yes" -> True
      Just "no"  -> False
      _          -> userExamOfficeGetSynced
    )

  getLabels <- lookupGetParam "labels" <&>
    (\case
      Just "yes" -> True
      Just "no"  -> False
      _          -> userExamOfficeGetLabels
    )

  (examsRes, examsTable) <- runDB $ do
    let labelFilterNoLabelOption = Option
          { optionDisplay        = mr MsgExamOfficeExamsNoLabel
          , optionInternalValue  = Nothing
          , optionExternalValue  = "no-label"
          }
    labelFilterOptions <- mkOptionList . (labelFilterNoLabelOption :) <$> do
      labels <- E.select . E.from $ \examOfficeLabel -> do
        E.where_ $ examOfficeLabel E.^. ExamOfficeLabelUser E.==. E.val uid
        E.orderBy [ E.asc $ examOfficeLabel E.^. ExamOfficeLabelName ]
        return examOfficeLabel
      return . flip map labels $ \(Entity lblId ExamOfficeLabel{..})
        -> Option { optionDisplay       = examOfficeLabelName
                  , optionInternalValue = Just lblId
                  , optionExternalValue = examOfficeLabelName
                  }

    let
      examLink :: Course -> Exam -> SomeRoute UniWorX
      examLink Course{..} Exam{..}
        = SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName EGradesR

      courseLink :: Course -> SomeRoute UniWorX
      courseLink Course{..}
        = SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR

      externalExamLink :: ExternalExam -> SomeRoute UniWorX
      externalExamLink ExternalExam{..}
        = SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEGradesR

      examActions :: Map ExamAction (AForm Handler ExamActionData)
      examActions = Map.fromList $
          bool mempty
        [ ( ExamSetLabel, ExamSetLabelData
            <$> apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersist [ExamOfficeLabelUser ==. uid] [Asc ExamOfficeLabelName] examOfficeLabelName) (fslI MsgExamLabel) Nothing
          )
        , ( ExamRemoveLabel, pure ExamRemoveLabelData )
        ] getLabels

      examsDBTable = DBTable{..}
        where
          dbtSQLQuery = runReaderT $ do
            exam               <- view queryExam
            course             <- view queryCourse
            school             <- view querySchool
            mExamLabel         <- view queryExamLabel
            mLabelExam         <- view queryLabelExam
            externalExam       <- view queryExternalExam
            mExternalExamLabel <- view queryExternalExamLabel
            mLabelExternalExam <- view queryLabelExternalExam

            lift $ do
              E.on $ mExternalExamLabel E.?. ExamOfficeExternalExamLabelLabel E.==. mLabelExternalExam E.?. ExamOfficeLabelId
              E.on $ E.maybe E.true (\externalExamLabelExternalExamId ->
                           externalExam E.?. ExternalExamId                   E.==.                  E.just externalExamLabelExternalExamId
                     )                                                             (mExternalExamLabel E.?. ExamOfficeExternalExamLabelExternalExam)
              E.on   E.false
              E.on $         mExamLabel E.?. ExamOfficeExamLabelLabel         E.==.         mLabelExam E.?. ExamOfficeLabelId
              E.on $ E.maybe E.true (\examLabelExamId ->
                                   exam E.?. ExamId                           E.==.                  E.just examLabelExamId
                     )                                                                     (mExamLabel E.?. ExamOfficeExamLabelExam)
              E.on $             course E.?. CourseSchool                     E.==.             school E.?. SchoolId
              E.on $               exam E.?. ExamCourse                       E.==.             course E.?. CourseId

              E.where_ $ (E.not_ (E.isNothing $ exam E.?. ExamId) E.&&. E.not_ (E.isNothing $ course E.?. CourseId) E.&&.         E.isNothing  (externalExam E.?. ExternalExamId))
                   E.||. (        E.isNothing  (exam E.?. ExamId) E.&&.         E.isNothing  (course E.?. CourseId) E.&&. E.not_ (E.isNothing $ externalExam E.?. ExternalExamId))
              E.where_ $ E.val (not getLabels) E.||. (
                         E.val getLabels
                   E.&&. E.maybe E.true (\labelExamUser ->
                                                            labelExamUser  E.==. E.val uid
                         )         (mLabelExam E.?. ExamOfficeLabelUser)
                   E.&&. E.maybe E.true (\labelExternalExamUser ->
                                                    labelExternalExamUser  E.==. E.val uid
                         ) (mLabelExternalExam E.?. ExamOfficeLabelUser)
                   )

            return (exam, course, school, mLabelExam, externalExam, mLabelExternalExam)
          dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))

          dbtProj :: _ ExamsTableData
          dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
            exam               <- view $ _dbtProjRow . _dbrOutput . _1
            course             <- view $ _dbtProjRow . _dbrOutput . _2
            school             <- view $ _dbtProjRow . _dbrOutput . _3
            mExamLabel         <- view $ _dbtProjRow . _dbrOutput . _4
            externalExam       <- view $ _dbtProjRow . _dbrOutput . _5
            mExternalExamLabel <- view $ _dbtProjRow . _dbrOutput . _6

            forMM_ (view $ _dbtProjFilter . _etProjFilterMayAccess) $ \b -> if
              | Just (Entity _ exam') <- exam
              , Just (Entity _ course') <- course
                -> guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ examLink course' exam'
              | Just (Entity _ eexam) <- externalExam
                -> guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ externalExamLink eexam
              | otherwise
                -> error "Got neither exam nor externalExam in result"

            let
              getExamResults = for_ exam $ \(Entity examId _) -> E.selectSource . E.from $ \examResult -> do
                E.where_ $ examResult E.^. ExamResultExam E.==. E.val examId
                E.where_ $ Exam.examOfficeExamResultAuth (E.val uid) examResult
                return $ Exam.resultIsSynced (E.val uid) examResult
              getExternalExamResults = for_ externalExam $ \(Entity externalExamId _) -> E.selectSource . E.from $ \externalExamResult -> do
                E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val externalExamId
                E.where_ $ ExternalExam.examOfficeExternalExamResultAuth (E.val uid) externalExamResult
                return $ ExternalExam.resultIsSynced (E.val uid) externalExamResult
              getResults = getExamResults >> getExternalExamResults
              foldResult (E.Value isSynced) = (Sum 1, guardMonoid isSynced $ Sum 1)
            
            mCounts <- if getSynced
              then do
                (Sum resCount, Sum synCount) <- lift . lift . runConduit $ getResults .| C.foldMap foldResult
                forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) $ \b ->
                  guard $ b == (resCount > 0)
                forMM_ (view $ _dbtProjFilter . _etProjFilterIsSynced) $ \b ->
                  guard $ b == (synCount >= resCount)
                return $ Just (resCount, synCount)
              else do
                forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) guard
                return Nothing

            case (exam, course, school, mExamLabel, externalExam, mExternalExamLabel) of
              (Just exam', Just course', Just school', mExamLabel', Nothing, Nothing) -> return
                (Right (exam', course', school', mExamLabel'), snd <$> mCounts, fst <$> mCounts)
              (Nothing, Nothing, Nothing, Nothing, Just externalExam', mExternalExamLabel') -> return
                (Left (externalExam', mExternalExamLabel'), snd <$> mCounts, fst <$> mCounts)
              _other -> return $ error "Got exam & externalExam in same result"


          colLabel = Colonnade.singleton (fromSortable . Sortable (Just "label") $ i18nCell MsgTableExamLabel) $ \x -> flip runReader x $ do
            mLabel <- preview resultLabel
            
            -- TODO: use select frontend util
            if
              | Just (Just (Entity _ ExamOfficeLabel{..})) <- mLabel
              -> return $ cell $(widgetFile "widgets/exam-office-label")
              | otherwise -> return $ cell mempty

          colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
            mExam    <- preview resultExam
            mSchool  <- preview resultSchool
            mSynced  <- view resultSynchronised
            mResults <- view resultResults

            if
              | Just (Entity _ Exam{examClosed, examFinished}) <- mExam
              , Just (Entity _ School{schoolExamCloseMode}) <- mSchool
              , bool ((min `on` NTop) examClosed examFinished > NTop (Just now))
                     (NTop examClosed > NTop (Just now))
                   $ is _ExamCloseSeparate schoolExamCloseMode
                -> return . cell $ toWidget iconNew
              | Just synced  <- mSynced
              , Just results <- mResults
                -> do
                  isSynced <- view resultIsSynced
                  return $ cell
                     [whamlet|
                       $newline never
                       $if isSynced
                         #{iconOK}
                       $else
                         #{synced}/#{results}
                     |]
                     & cellAttrs <>~ [ ("class", "heated")
                                     , ("style", [st|--hotness: #{tshow (heat results synced)}|])
                                     ]
              | otherwise -> return $ cell mempty


          dbtColonnade :: Colonnade Sortable _ _
          dbtColonnade = mconcat
            [ bool mempty (dbSelect (applying _2) id $ \DBRow{ dbrOutput=(ex,_,_) } -> return $ bimap (\(Entity eeId _,_) -> eeId) (\(Entity eId _,_,_,_) -> eId) ex) (not $ Map.null examActions)
            , bool mempty colLabel  getLabels
            , bool mempty colSynced getSynced
            , maybeAnchorColonnade ( runMaybeT $     mpreview ($(multifocusG 2) (pre $ resultCourse . _entityVal) (pre $ resultExam . _entityVal) . to (uncurry $ liftA2 examLink) . _Just)
                                                 <|> mpreviews (resultExternalExam . _entityVal) externalExamLink
                                   )
                $ emptyOpticColonnade (resultExam . _entityVal . _examName <> resultExternalExam . _entityVal . _externalExamExamName) colExamName
            , emptyOpticColonnade (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd) colExamTime
            , emptyOpticColonnade (resultExam . _entityVal . _examFinished) colExamFinishedOffice
            , emptyOpticColonnade (resultExam . _entityVal . _examClosed) colExamClosed
            , maybeAnchorColonnade (previews (resultCourse . _entityVal) courseLink)
                $ emptyOpticColonnade (resultCourse . _entityVal . _courseName <> resultExternalExam . _entityVal . _externalExamCourseName) colCourseName
            , emptyOpticColonnade (resultCourse . _entityVal . _courseSchool <> resultExternalExam . _entityVal . _externalExamSchool) colSchool
            , emptyOpticColonnade (resultCourse . _entityVal . _courseTerm <> resultExternalExam . _entityVal . _externalExamTerm) colTermShort
            ]
          dbtSorting = mconcat $
              bool mempty
            [ singletonMap "label-prio" $
                SortProjected . comparing $ (fmap . fmap $ examOfficeLabelPriority . entityVal) <$> preview resultLabel
            , singletonMap "label-status" $
                SortProjected . comparing $ (fmap . fmap $ examOfficeLabelStatus . entityVal) <$> preview resultLabel
            ] getLabels <>
              bool mempty
            [ singletonMap "synced" $
                SortProjected . comparing $ ((/) `on` toRational . fromMaybe 0) <$> view resultSynchronised <*> view resultResults
            , singletonMap "is-synced" $
                SortProjected . comparing $ (>=) <$> view resultSynchronised <*> view resultResults
            ] getSynced <>
            [ sortExamName (to $ E.unsafeCoalesce . sequence [views queryExam (E.?. ExamName), views queryExternalExam (E.?. ExternalExamExamName)])
            , sortExamTime (queryExam . $(multifocusG 2) (to $ E.joinV . (E.?. ExamStart)) (to $ E.joinV . (E.?. ExamEnd)))
            , sortExamFinished (queryExam . to (E.joinV . (E.?. ExamFinished)))
            , sortExamClosed (queryExam . to (E.joinV . (E.?. ExamClosed)))
            , sortCourseName (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseName), views queryExternalExam (E.?. ExternalExamCourseName)])
            , sortSchool (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseSchool), views queryExternalExam (E.?. ExternalExamSchool)])
            , sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
            ]

          dbtFilter = mconcat
            [ singletonMap "may-access"  . FilterProjected $ (_etProjFilterMayAccess  ?~) . getAny
            , singletonMap "has-results" . FilterProjected $ (_etProjFilterHasResults ?~) . getAny
            , singletonMap "is-synced"   . FilterProjected $ (_etProjFilterIsSynced   ?~) . getAny
            , singletonMap "label"       . FilterColumn . E.mkExactFilter $ views queryLabelExam (E.?. ExamOfficeLabelId)
            ]
          dbtFilterUI mPrev = mconcat $
            [ prismAForm (singletonFilter "label"     . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return labelFilterOptions) (fslI MsgExamLabel)
            | getLabels ] <>
            [ prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamSynchronised)
            | getSynced ]

          dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }

          dbtParams = DBParamsForm
            { dbParamsFormMethod = POST
            , dbParamsFormAction = Just . SomeRoute $ ExamOfficeR EOExamsR
            , dbParamsFormAttrs  = []
            , dbParamsFormSubmit = FormSubmit
            , dbParamsFormAdditional
                = renderAForm FormStandard
                    $  (, mempty) . First . Just
                   <$> multiActionA examActions (fslI MsgTableAction) Nothing
            , dbParamsFormEvaluate = liftHandler . runFormPost
            , dbParamsFormResult   = id
            , dbParamsFormIdent    = def
            }

          dbtIdent :: Text
          dbtIdent = "exams"

          dbtCsvEncode = noCsvEncode
          dbtCsvDecode = Nothing

          dbtExtraReps = []

      examsDBTableValidator = def
        & defaultSorting (bool mempty [SortDescBy "label-prio", SortAscBy "label-status"] getLabels <> bool mempty [SortAscBy "is-synced"] getSynced <> [SortAscBy "exam-time"])
        & forceFilter "may-access" (Any True)
        & forceFilter "has-results" (Any True)

      postprocess :: FormResult (First ExamActionData , DBFormResult (Either ExternalExamId ExamId) Bool (DBRow (Either (Entity ExternalExam, Maybe (Entity ExamOfficeLabel)) (Entity Exam, Entity Course, Entity School, Maybe (Entity ExamOfficeLabel)), Maybe Natural, Maybe Natural)))
                  -> FormResult (      ExamActionData ,          Set (Either ExternalExamId ExamId))
      postprocess (FormFailure errs)  = FormFailure errs
      postprocess  FormMissing        = FormMissing
      postprocess (FormSuccess (First mExamActionData, examRes))
        | Just act <- mExamActionData = FormSuccess . (act,) . Map.keysSet . Map.filter id $ getDBFormResult (const False) examRes
        | otherwise                   = FormMissing

    over _1 postprocess <$> dbTable examsDBTableValidator examsDBTable

  formResult examsRes $ \(examAction, exams) -> case examAction of
    ExamSetLabelData{..} -> do
      runDB . forM_ (Set.toList exams) $ either (\eeid -> void $ upsert (ExamOfficeExternalExamLabel eeid easlNewLabel) [ExamOfficeExternalExamLabelLabel =. easlNewLabel]) (\eid -> void $ upsert (ExamOfficeExamLabel eid easlNewLabel) [ExamOfficeExamLabelLabel =. easlNewLabel])
      addMessageI Success $ MsgExamLabelsSet (Set.size exams)
      redirect $ ExamOfficeR EOExamsR
    ExamRemoveLabelData -> do
      runDB . forM_ (Set.toList exams) $ either
        (\eeId -> E.delete . E.from $ \extExLabel -> E.where_ (extExLabel E.^. ExamOfficeExternalExamLabelExternalExam E.==. E.val eeId))
        (\eId  -> E.delete . E.from $ \exLabel -> E.where_ (exLabel E.^. ExamOfficeExamLabelExam E.==. E.val eId))
      addMessageI Success $ MsgExamLabelsRemoved (Set.size exams)
      redirect $ ExamOfficeR EOExamsR

  siteLayoutMsg MsgHeadingExamList $ do
    setTitleI MsgHeadingExamList
    examsTable