{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Handler.Course where

import Import
import Handler.Utils

-- import Data.Time
import qualified Data.Text as T
import Data.Function ((&))
-- import Yesod.Form.Bootstrap3

import qualified Data.Map as Map

import Colonnade hiding (fromMaybe,bool)
-- import Yesod.Colonnade

import qualified Database.Esqueleto as E

import qualified Data.UUID.Cryptographic as UUID


getCourseListR :: Handler TypedContent
getCourseListR = redirect TermCurrentR

getTermCurrentR :: Handler Html
getTermCurrentR = do
  termIds  <- runDB $ selectKeysList [TermActive ==. True] [Desc TermName]
  case fromNullable termIds of
    Nothing -> notFound
    (Just (maximum -> tid)) -> -- getTermCourseListR tid
        redirect $ TermCourseListR tid -- redirect avids problematic breadcrumbs, headings, etc.


getTermCourseListR :: TermId -> Handler Html
getTermCourseListR tid = do
  void . runDB $ get404 tid -- Just ensure the term exists

  let
    tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64))
    tableData course = do
      E.where_ $ course E.^. CourseTerm E.==. E.val tid
      let
        participants = E.sub_select . E.from $ \courseParticipant -> do
          E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
          return (E.countRows :: E.SqlExpr (E.Value Int64))
      return (course, participants)
    psValidator = def
      & defaultSorting [("shorthand", SortAsc)]

  coursesTable <- dbTable psValidator $ DBTable
    { dbtSQLQuery  = tableData
    , dbtColonnade = widgetColonnade $ mconcat
        [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell'
            (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR)
            (\(Entity _ Course{..}, _) -> toWidget courseShorthand)
        , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterFrom
        , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterTo
        , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
            Nothing -> MsgCourseMembersCount num
            Just max -> MsgCourseMembersCountLimited num max
        ]
    , dbtSorting = Map.fromList
        [ ( "shorthand"
          , SortColumn $ \course -> course E.^. CourseShorthand
          )
        , ( "register-from"
          , SortColumn $ \course -> course E.^. CourseRegisterFrom
          )
        , ( "register-to"
          , SortColumn $ \course -> course E.^. CourseRegisterTo
          )
        , ( "members"
          , SortColumn $ \course -> E.sub_select . E.from $ \courseParticipant -> do
              E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
              return (E.countRows :: E.SqlExpr (E.Value Int64))
          )
        ]
    , dbtFilter = mempty
    , dbtStyle = def
    , dbtIdent = "courses" :: Text
    }
  
  defaultLayout $ do
    setTitleI . MsgTermCourseListTitle $ tid
    $(widgetFile "courses")

getCShowR :: TermId -> Text -> Handler Html
getCShowR tid csh = do
  mbAid <- maybeAuthId
  (courseEnt,(schoolMB,participants,registered)) <- runDB $ do
      courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort tid csh
      dependent <- (,,)
          <$> get (courseSchool course)               -- join
          <*> count [CourseParticipantCourse ==. cid] -- join
          <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
                Nothing -> return False
                (Just aid) -> do
                                regL <- getBy (UniqueParticipant aid cid)
                                return $ isJust regL)
      return $ (courseEnt,dependent)
  let course = entityVal courseEnt
  (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
  registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid csh CRegisterR) True
  defaultLayout $ do
    setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
    $(widgetFile "course")


registerForm :: Bool -> Maybe Text -> Form Bool
registerForm registered msecret extra = do
  (msecretRes', msecretView) <- case msecret of
    (Just _) | not registered -> bimap Just Just <$> (mreq textField (fslpI MsgCourseSecret "Code") Nothing)
    _ -> return (Nothing,Nothing)
  (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
  let widget = $(widgetFile "widgets/registerForm")
  let msecretRes | Just res <- msecretRes' = Just <$> res
                 | otherwise               = FormSuccess Nothing
  return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes


postCRegisterR :: TermId -> Text -> Handler Html
postCRegisterR tid csh = do
  aid <- requireAuthId
  (cid, course, registered) <- runDB $ do
      (Entity cid course) <- getBy404 $ CourseTermShort tid csh
      registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
      return (cid, course, registered)
  ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
  case regResult of
    (FormSuccess codeOk)
      | registered -> do
          runDB $ deleteBy $ UniqueParticipant aid cid
          addMessageI "info" MsgCourseDeregisterOk
      | codeOk -> do
          actTime <- liftIO $ getCurrentTime
          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
          when (isJust regOk) $ addMessageI "success" MsgCourseRegisterOk
      | otherwise -> addMessageI "danger" MsgCourseSecretWrong
    (_other) -> return () -- TODO check this!
  redirect $ CourseR tid csh CShowR

getCourseNewR :: Handler Html
getCourseNewR = do
  -- TODO: Defaults für Semester hier ermitteln und übergeben
  courseEditHandler True Nothing

postCourseNewR :: Handler Html
postCourseNewR = courseEditHandler False Nothing

getCEditR :: TermId -> Text -> Handler Html
getCEditR tid csh = do
  course <- runDB $ getBy $ CourseTermShort tid csh
  courseEditHandler True course

postCEditR :: TermId -> Text -> Handler Html
postCEditR tid csh = do
  course <- runDB $ getBy $ CourseTermShort tid csh
  courseEditHandler False course


courseDeleteHandler :: Handler Html -- not called anywhere yet
courseDeleteHandler = undefined
{- TODO
        | False -- DELETE -- TODO: This no longer works that way!!! See new way in Handler.Term.termEditHandler
        , Just cid <- cfCourseId res -> do
            runDB $ deleteCascade cid -- TODO Sicherheitsabfrage einbauen!
            let cti = toPathPiece $ cfTerm res
            addMessage "info" [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht!|]
            redirect $ TermCourseListR $ cfTerm res
-}

courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html
courseEditHandler isGet course = do
    aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
    ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
    case result of
      (FormSuccess res@(
        CourseForm  { cfCourseId = Nothing
                    , cfShort    = csh
                    , cfTerm     = tid
                    })) ->  do -- create new course
          now <- liftIO getCurrentTime
          insertOkay <- runDB $ insertUnique $ Course
            { courseName            = cfName     res
            , courseDescription     = cfDesc     res
            , courseLinkExternal    = cfLink     res
            , courseShorthand       = cfShort    res
            , courseTerm            = cfTerm     res
            , courseSchool          = cfSchool   res
            , courseCapacity        = cfCapacity res
            , courseRegisterSecret  = cfSecret   res
            , courseMaterialFree    = cfMatFree  res
            , courseRegisterFrom    = cfRegFrom  res
            , courseRegisterTo      = cfRegTo    res
            , courseDeregisterUntil = cfDeRegUntil res
            }
          case insertOkay of
            (Just cid) -> do
              runDB $ do
                insert_ $ CourseEdit aid now cid
                insert_ $ Lecturer aid cid
              addMessageI "info" $ MsgCourseNewOk tid csh
              redirect $ TermCourseListR tid
            Nothing ->
              addMessageI "danger" $ MsgCourseNewDupShort tid csh

      (FormSuccess res@(
        CourseForm  { cfCourseId = Just cid
                    , cfShort    = csh
                    , cfTerm     = tid
                    })) -> do -- edit existing course
          now <- liftIO getCurrentTime
          -- addMessage "debug" [shamlet| #{show res}|]
          runDB $ do
            old <- get cid
            case old of
              Nothing -> addMessageI "error" $ MsgInvalidInput
              (Just oldCourse) -> do
            -- existing <- getBy $ CourseTermShort tid csh
            -- if ((entityKey <$> existing) /= Just cid)
            --  then addMessageI "danger" $ MsgCourseEditDupShort tid csh
            --   else do
                _updOkay <- replace cid (  -- TODO replaceUnique requires Eq?!
                    Course  {  courseName            = cfName       res
                            ,  courseDescription     = cfDesc       res
                            ,  courseLinkExternal    = cfLink       res
                            ,  courseShorthand       = cfShort      res
                            ,  courseTerm            = cfTerm       res
                            ,  courseSchool          = cfSchool     res
                            ,  courseCapacity        = cfCapacity   res
                            ,  courseRegisterSecret  = cfSecret     res
                            ,  courseMaterialFree    = cfMatFree    res
                            ,  courseRegisterFrom    = cfRegFrom    res
                            ,  courseRegisterTo      = cfRegTo      res
                            ,  courseDeregisterUntil = cfDeRegUntil res
                    }
                  )
                insert_ $ CourseEdit aid now cid
--                 if (isNothing updOkay)
--                   then do
                addMessageI "success" $ MsgCourseEditOk tid csh
                -- redirect $ TermCourseListR tid
--                   else addMessageI "danger" $ MsgCourseEditDupShort tid csh

      (FormFailure _) -> addMessageI "warning" MsgInvalidInput
      (FormMissing) | isGet -> return ()
      other -> addMessage "error" $ [shamlet| Error: #{show other}|]
    actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
    defaultLayout $ do
      setTitleI MsgCourseEditTitle
      $(widgetFile "formPage")


data CourseForm = CourseForm
        { cfCourseId   :: Maybe CourseId -- Maybe CryptoUUIDCourse
        , cfName       :: Text
        , cfDesc       :: Maybe Html
        , cfLink       :: Maybe Text
        , cfShort      :: Text
        , cfTerm       :: TermId
        , cfSchool     :: SchoolId
        , cfCapacity   :: Maybe Int64
        , cfSecret     :: Maybe Text
        , cfMatFree    :: Bool
        , cfRegFrom    :: Maybe UTCTime
        , cfRegTo      :: Maybe UTCTime
        , cfDeRegUntil :: Maybe UTCTime
        }

instance Show CourseForm where
  show cf = T.unpack (cfShort cf) ++ ' ':(show $ cfCourseId cf)


courseToForm :: Entity Course -> CourseForm
courseToForm cEntity = CourseForm
        { cfCourseId   = Just $ entityKey cEntity
        , cfName       = courseName               course
        , cfDesc       = courseDescription        course
        , cfLink       = courseLinkExternal       course
        , cfShort      = courseShorthand          course
        , cfTerm       = courseTerm               course
        , cfSchool     = courseSchool             course
        , cfCapacity   = courseCapacity           course
        , cfSecret     = courseRegisterSecret     course
        , cfMatFree    = courseMaterialFree       course
        , cfRegFrom    = courseRegisterFrom       course
        , cfRegTo      = courseRegisterTo         course
        , cfDeRegUntil = courseDeregisterUntil    course
        }
  where
    course = entityVal cEntity

newCourseForm :: Maybe CourseForm -> Form CourseForm
newCourseForm template = identForm FIDcourse $ \html -> do
    -- mopt hiddenField
    --     cidKey <- getsYesod appCryptoIDKey
    --     courseId <- runMaybeT $ do
    --         cid <- cfCourseId template
    --         UUID.encrypt cidKey cid
    (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
      -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
      <$> aopt hiddenField "KursId"             (cfCourseId <$> template)
      <*> areq textField (fsb "Name")           (cfName     <$> template)
      <*> aopt htmlField (fsb "Beschreibung")   (cfDesc     <$> template)
      <*> aopt urlField  (fsb "Homepage")       (cfLink     <$> template)
      <*> areq textField (fsb "Kürzel"
            -- & addAttr "disabled" "disabled"
            & setTooltip "Muss innerhalb des Semesters eindeutig sein")
                                                (cfShort  <$> template)
      <*> areq termActiveField        (fsb "Semester")       (cfTerm     <$> template)
      <*> areq schoolField            (fsb "Institut")       (cfSchool   <$> template)
      <*> aopt (natField "Kapazität") (fsb "Kapazität")      (cfCapacity <$> template)
      <*> aopt textField              (fslpI MsgCourseSecret "beliebige Zeichenkette"
            & setTooltip "Optional: Anmeldung zum Kurs benötigt ein Passwort")
                                                             (cfSecret   <$> template)
      <*> areq checkBoxField          (fslI  MsgMaterialFree)(cfMatFree  <$> template)
      <*> aopt utcTimeField           (fslpI MsgRegisterFrom "Datum, sonst KEINE Anmeldung"
            & setTooltip "Ohne Datum ist keine Anmeldung zu diesem Kurs möglich!")
                                                             (cfRegFrom  <$> template)
      <*> aopt utcTimeField           (fslpI MsgRegisterTo   "Datum, sonst unbegr. Anmeldung"
            & setTooltip "Die Anmeldung darf ohne Begrenzung sein")
                                                             (cfRegTo    <$> template)
      <*> aopt utcTimeField           (fslpI MsgDeRegUntil   "Datum, sonst unbegr. Abmeldung"
            & setTooltip "Die Abmeldung darf ohne Begrenzung sein")
                                                             (cfDeRegUntil <$> template)
      <*  submitButton
    return $ case result of
      FormSuccess courseResult
        | errorMsgs <- validateCourse courseResult
        , not $ null errorMsgs ->
          (FormFailure errorMsgs,
                [whamlet|
                  <div class="alert alert-danger">
                    <div class="alert__content">
                      <h4> Fehler:
                      <ul>
                        $forall errmsg <- errorMsgs
                          <li> #{errmsg}
                  ^{widget}
                |]
              )
      _ -> (result, widget)
--  where
--     cid :: Maybe CourseId
--     cid = join $ cfCourseId <$> template


validateCourse :: CourseForm -> [Text]
validateCourse (CourseForm{..}) =
  [ msg | (False, msg) <-
    [
      ( NTop cfRegFrom <= NTop cfRegTo
      , "Ende des Anmeldezeitraums muss nach dem Anfang liegen"
      )
    ,
      ( NTop cfRegFrom <= NTop cfDeRegUntil
      , "Ende des Abmeldezeitraums muss nach dem Anfang liegen"
      )
--    No starting date is okay: effective immediately
--       ( cfHasReg <= (isNothing cfRegFrom)
--       , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren"
--       )
--     ,
  ] ]