{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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  

getCourseListTermR :: TermId -> Handler Html
getCourseListTermR tidini = do
  (term,courses) <- runDB $ (,) 
      <$> get tidini
      <*> selectList [CourseTermId ==. 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 = courseTermId c
            in [whamlet| <a href=@{CourseShowR tid shd}>#{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 [CourseParticipantCourseId ==. cid]
              [whamlet| #{show partiNum} |]
            )
        , headed " " $ (\ckv -> 
            let c   = entityVal ckv
                shd = courseShorthand c  
                tid = courseTermId c
            in do
              adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
              -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditExistR tid shd) else ""
              [whamlet| 
                $if adminLink == Authorized
                  <a href=@{CourseEditExistR tid shd}>
                    editieren
              |]
          )  
        ]
  let pageLinks = 
        [ NavbarLeft $ MenuItem
          { menuItemLabel = "Neuer Kurs"
          , menuItemRoute = CourseEditR
          , menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseEditR False
          }
        ] 
  defaultLinkLayout pageLinks $ do
--   defaultLayout $ do
    setTitle "Semesterkurse"  
    linkButton "Neuen Kurs anlegen" BCPrimary CourseEditR
    encodeHeadedWidgetTable tableDefault colonnadeTerms courses -- (map entityVal courses)

getCourseShowR :: TermId -> Text -> Handler Html
getCourseShowR tid csh = do
  mbAid <- maybeAuthId
  (courseEnt,(schoolMB,participants,mbRegistered)) <- runDB $ do
      courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort tid csh
      dependent <- (,,) 
          <$> get (courseSchoolId course)               -- join
          <*> count [CourseParticipantCourseId ==. cid] -- join 
          <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
                Nothing -> return False
                (Just aid) -> do
                                regL <- getBy (UniqueCourseParticipant cid aid)
                                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
    
postCourseShowR :: TermId -> Text -> Handler Html
postCourseShowR tid csh = do
  aid <- requireAuthId
  (cid, registered) <- runDB $ do
      (Entity cid _) <- getBy404 $ CourseTermShort tid csh
      registered <- isJust <$> (getBy $ UniqueCourseParticipant cid aid)
      return (cid, registered)
  ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerButton registered      
  case regResult of 
    (FormSuccess _)
      | registered -> do                    
          runDB $ deleteBy $ UniqueCourseParticipant cid aid 
          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
  getCourseShowR tid csh  
  
getCourseEditR :: Handler Html
getCourseEditR = do
  -- TODO: Defaults für Semester hier ermitteln und übergeben
  courseEditHandler Nothing
  
postCourseEditR :: Handler Html
postCourseEditR = courseEditHandler Nothing
  
getCourseEditExistR :: TermId -> Text -> Handler Html
getCourseEditExistR tid csh = do  
  course <- runDB $ getBy $ CourseTermShort tid csh
  courseEditHandler course

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

     
courseEditHandler :: Maybe (Entity Course) -> Handler Html
courseEditHandler course = do
    aid <- requireAuthId
    ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course
    action <- lookupPostParam "formaction"
    case (result,action) of
      (FormSuccess res, fAct) 
        | fAct == formActionDelete
        , 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 $ CourseListTermR $ cfTerm res
        | fAct == formActionSave 
        , Just cid <- cfCourseId res -> do 
            let tid = cfTerm  res
            actTime <- liftIO getCurrentTime
            updateokay <- runDB $ do
              exists <- getBy $ CourseTermShort tid $ cfShort res 
              let upokay = isNothing exists
              when upokay $ 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?!
                , CourseTermId       =. tid            -- TODO: change here should generate a warning, or only allowed for Admins?!
                , CourseSchoolId     =. cfSchool   res
                , CourseCapacity     =. cfCapacity res
                , CourseRegisterFrom =. cfRegFrom  res
                , CourseRegisterTo   =. cfRegTo    res
                , CourseChangedBy    =. aid
                , CourseChanged      =. actTime
                ]
              return upokay
            let cti = toPathPiece $ cfTerm res
            if updateokay 
              then do 
                addMessage "info" [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
                redirect $ CourseListTermR $ cfTerm res
              else do
                addMessage "danger" [shamlet| Kurs #{cti}/#{cfShort res} konnte nicht geändert werden. 
                    \ Es gibt bereits einen anderen Kurs mit diesem Kürzel in diesem Semester.|]
        | fAct == formActionSave
        , Nothing <- cfCourseId res -> do
            actTime <- liftIO getCurrentTime
            insertOkay <- runDB $ insertUnique $ Course 
                { courseName            = cfName     res
                , courseDescription     = cfDesc     res
                , courseLinkExternal    = cfLink     res
                , courseShorthand       = cfShort    res
                , courseTermId          = cfTerm     res
                , courseSchoolId        = cfSchool   res
                , courseCapacity        = cfCapacity res
                , courseHasRegistration = cfHasReg   res
                , courseRegisterFrom    = cfRegFrom  res
                , courseRegisterTo      = cfRegTo    res
                , courseCreated         = actTime
                , courseChanged         = actTime
                , courseCreatedBy       = aid
                , courseChangedBy       = aid
                } 
            case insertOkay of 
                (Just cid) -> do
                  runDB $ insert_ $ Lecturer aid cid 
                  let cti = toPathPiece $ cfTerm res
                  addMessage "info" [shamlet|Kurs #{cti}/#{cfShort res} wurde angelegt.|]
                  redirect $ CourseListTermR $ cfTerm res
                Nothing -> do
                  let cti = toPathPiece $ cfTerm res
                  addMessage "danger" [shamlet|Es gibt bereits einen Kurs #{cfShort res} in Semester #{cti}.|]      
      (FormFailure _,_) -> addMessage "warning" "Bitte Eingabe korrigieren."            
      _other -> return ()
    let formTitle   = "Kurs editieren/anlegen" :: Text
    let actionUrl   = CourseEditR
    let formActions = defaultFormActions
    defaultLayout $ do
      setTitle [shamlet| #{formTitle} |]
      $(widgetFile "generic_form")
      
      
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     = courseTermId             course
        , cfSchool   = courseSchoolId           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)
      -- <*  bootstrapSubmit (bsSubmit (show cid)) 
    return $ case result of  
      FormSuccess courseResult 
        | errorMsgs <- validateCourse courseResult
        , not $ null errorMsgs ->
          (FormFailure errorMsgs,
                [whamlet|
                  <div class="alert alert-danger">
                    <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"
      )
  ] ]