{-# 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 Colonnade hiding (fromMaybe)
import Yesod.Colonnade

import qualified Data.UUID.Cryptographic as UUID


getCourseListR :: Handler TypedContent
getCourseListR = redirect TermShowR

getTermCurrentR :: Handler Html
getTermCurrentR = do
  termIds  <- runDB $ selectKeysList [TermActive ==. True] [] -- [Desc TermName] does not work, since database representation has wrong ordering
  case fromNullable termIds of
    Nothing -> notFound
    (Just (maximum -> tid)) -> getTermCourseListR tid

getTermCourseListR :: TermId -> Handler Html
getTermCourseListR tidini = do
  (term,courses) <- runDB $ (,)
      <$> get tidini
      <*> selectList [CourseTerm ==. tidini] [Asc CourseShorthand]
  when (isNothing term) $ do
    addMessage "warning" [shamlet| Semester #{toPathPiece tidini} nicht gefunden. |]
    redirect TermShowR
  -- TODO: several runDBs per TableRow are probably too inefficient!
  let colonnadeTerms = mconcat
        [ headed "Kürzel" $ (\ckv ->
            let c   = entityVal ckv
                shd = courseShorthand c
                tid = courseTerm c
            in [whamlet| <a href=@{CourseR tid shd CShowR}>#{shd} |] )
--         , headed "Institut" $ [shamlet| #{course} |]
        , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal
        , headed "Ende Anmeldung"   $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal
        , headed "Teilnehmer" $ (\ckv -> do
              let cid = entityKey ckv
              partiNum <- handlerToWidget $ runDB $ count [CourseParticipantCourse ==. cid]
              [whamlet| #{show partiNum} |]
            )
        , headed " " $ (\ckv ->
            let c   = entityVal ckv
                shd = courseShorthand c
                tid = courseTerm c
            in do
              adminLink <- handlerToWidget $ isAuthorized (CourseR tid shd CEditR) False
              -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CEditR tid shd) else ""
              [whamlet|
                $if adminLink == Authorized
                  <a href=@{CourseR tid shd CEditR}>
                    editieren
              |]
          )
        ]
  let coursesTable = encodeWidgetTable tableSortable colonnadeTerms courses
  defaultLayout $ do
    setTitleI . MsgTermCourseListTitle $ unTermKey tidini
    $(widgetFile "courses")

getCShowR :: TermId -> Text -> Handler Html
getCShowR tid csh = do
  mbAid <- maybeAuthId
  (courseEnt,(schoolMB,participants,mbRegistered)) <- 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" $ registerButton $ mbRegistered
  defaultLayout $ do
    setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
    $(widgetFile "course")

registerButton :: Bool -> Form ()
registerButton registered = renderAForm FormStandard $
      pure () <*  bootstrapSubmit regMsg
  where
    msg    = if registered then "Abmelden" else "Anmelden"
    regMsg = msg :: BootstrapSubmit Text

postCShowR :: TermId -> Text -> Handler Html
postCShowR tid csh = do
  aid <- requireAuthId
  (cid, registered) <- runDB $ do
      (Entity cid _) <- getBy404 $ CourseTermShort tid csh
      registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
      return (cid, registered)
  ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerButton registered
  case regResult of
    (FormSuccess _)
      | registered -> do
          runDB $ deleteBy $ UniqueParticipant aid cid
          addMessage "info" "Sie wurden abgemeldet."
      | otherwise  -> do
          actTime <- liftIO $ getCurrentTime
          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
          when (isJust regOk) $ addMessage "success" "Erfolgreich angemeldet!"
    (_other) -> return () -- TODO check this!
  -- redirect or not?! I guess not, since we want GET now
  getCShowR tid csh

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

getCourseEditIDR :: CryptoUUIDCourse -> Handler Html
getCourseEditIDR cID = do
  cIDKey <- getsYesod appCryptoIDKey
  courseID <- UUID.decrypt cIDKey cID
  courseEditHandler True =<< runDB (getEntity courseID)


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
          let tident = unTermKey tid
          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
            , courseHasRegistration = cfHasReg   res
            , courseRegisterFrom    = cfRegFrom  res
            , courseRegisterTo      = cfRegTo    res
            , courseDeregisterUntil = Nothing -- TODO
            , courseRegisterSecret  = Nothing -- TODO
            , courseMaterialFree    = True    -- TODO
            }
          case insertOkay of
            (Just cid) -> do
              runDB $ do
                insert_ $ CourseEdit aid now cid
                insert_ $ Lecturer aid cid
              addMessageI "info" $ MsgCourseNewOk tident csh
              redirect $ TermCourseListR tid
            Nothing ->
              addMessageI "danger" $ MsgCourseNewDupShort tident csh

      (FormSuccess res@(
        CourseForm  { cfCourseId = Just cid
                    , cfShort    = csh
                    , cfTerm     = tid
                    })) -> do -- edit existing course
          let tident = unTermKey tid
          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 tident csh
            --   else do
                -- addMessage "debug" $ fromMaybe [shamlet|No description given.|] $ cfDesc res
--                 update cid
--                   [ CourseName         =. cfName     res
--                   , CourseDescription  =. cfDesc     res
--                   , CourseLinkExternal =. cfLink     res
--                   , CourseShorthand    =. cfShort    res -- TODO: change here should generate a warning, or only allowed for Admins?!
--                   , CourseTerm       =. tid            -- TODO: change here should generate a warning, or only allowed for Admins?!
--                   , CourseSchool     =. cfSchool   res
--                   , CourseCapacity     =. cfCapacity res
--                   , CourseRegisterFrom =. cfRegFrom  res
--                   , CourseRegisterTo   =. cfRegTo    res
--                   , CourseChangedBy    =. aid
--                   , CourseChanged      =. now
--                   ]
                _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
                            ,  courseHasRegistration = cfHasReg   res
                            ,  courseRegisterFrom    = cfRegFrom  res
                            ,  courseRegisterTo      = cfRegTo    res
                            ,  courseDeregisterUntil = Nothing -- TODO
                            ,  courseRegisterSecret  = Nothing -- TODO
                            ,  courseMaterialFree    = True    -- TODO
                    }
                  )
                insert_ $ CourseEdit aid now cid
--                 if (isNothing updOkay)
--                   then do
                addMessageI "success" $ MsgCourseEditOk tident csh
                -- redirect $ TermCourseListR tid
--                   else addMessageI "danger" $ MsgCourseEditDupShort tident 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 Int
        , cfHasReg   :: Bool
        , cfRegFrom  :: Maybe UTCTime
        , cfRegTo    :: 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
        , cfHasReg   = courseHasRegistration    course
        , cfRegFrom  = courseRegisterFrom       course
        , cfRegTo    = courseRegisterTo         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)
      <*> areq checkBoxField          (fsb "Anmeldung")      (cfHasReg   <$> template)
      <*> aopt utcTimeField           (fsb "Anmeldung von:") (cfRegFrom  <$> template)
      <*> aopt utcTimeField           (fsb "Anmeldung bis:") (cfRegTo    <$> 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) <-
    [
      ( cfRegFrom <= cfRegTo
      , "Ende des Anmeldezeitraums muss nach dem Anfang liegen"
      )
    ,
--    No starting date is okay: effective immediately
--       ( cfHasReg <= (isNothing cfRegFrom)
--       , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren"
--       )
--     ,
      ( cfHasReg == (isJust cfRegTo)
      , "Ende des Anmeldezeitraums angeben oder Anmeldungen deaktivieren"
      )
    ,
      ( isJust cfRegFrom <= cfHasReg
      , "Anmeldungen aktivieren oder Anmeldezeitraum löschen"
      )
  ] ]