{-# 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 Yesod.Form.Bootstrap3 

import Colonnade hiding (fromMaybe)
import Yesod.Colonnade 

import qualified Data.UUID.Cryptographic as UUID


getCourseListR :: Handler TypedContent
getCourseListR = redirect TermShowR  

getCourseListTermR :: TermIdentifier -> Handler Html
getCourseListTermR tidini = do
  (term,courses) <- runDB $ (,) 
      <$> get (TermKey tidini) 
      <*> selectList [CourseTermId ==. TermKey tidini] [Asc CourseShorthand] 
  when (isNothing term) $ do
    setMessage [shamlet| Semester #{termToText tidini} nicht gefunden. |]
    redirect TermShowR
  let colonnadeTerms = mconcat 
        [ headed "Kürzel" $ (\c -> 
            let shd = courseShorthand c  
                tid = unTermKey $ courseTermId c
            in [whamlet| <a href=@{CourseShowR tid shd}>#{shd} |] )                      
--         , headed "Institut" $ [shamlet| #{course} |]
        , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom
        , headed "Ende Anmeldung"   $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo
        , headed " " $ (\c -> 
            let shd = courseShorthand c  
                tid = unTermKey $ courseTermId c
            in do
              adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
              [whamlet| 
                $if adminLink == Authorized
                  <a href=@{CourseEditExistR tid shd}>
                    editieren
              |] )  
        ]  
  defaultLayout $ do
    setTitle "Semesterkurse"            
    encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal courses)

getCourseShowR :: TermIdentifier -> Text -> Handler Html
getCourseShowR tid csh = do
  mbAid <- maybeAuthId
  (courseEnt,(schoolMB,participants,mbRegistered)) <- runDB $ do
      courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort (TermKey tid) csh
      dependent <- (,,) 
          <$> get (courseSchoolId course)               -- join
          <*> count [CourseParticipantCourseId ==. cid] -- join 
          <*> (case mbAid of -- 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| #{termToText tid} - #{csh}|]
    $(widgetFile "course")
      
registerButton :: Bool -> Form ()
registerButton registered =
    renderBootstrap3  bsHorizontalDefault $       
      pure () <*  bootstrapSubmit regMsg 
  where 
    msg    = if registered then "Abmelden" else "Anmelden"
    regMsg = msg :: BootstrapSubmit Text
    
postCourseShowR :: TermIdentifier -> Text -> Handler Html
postCourseShowR tid csh = do
  aid <- requireAuthId
  (cid, registered) <- runDB $ do
      (Entity cid _) <- getBy404 $ CourseTermShort (TermKey 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 
          setMessage "Sie wurden abgemeldet."
      | otherwise  -> do
          actTime <- liftIO $ getCurrentTime
          regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
          when (isJust regOk) $ setMessage "Erfolgreich angemeldet!"
  -- 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 :: TermIdentifier -> Text -> Handler Html  
getCourseEditExistR tid csh = do  
  course <- runDB $ getBy $ CourseTermShort (TermKey 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 = termToText $ cfTerm res
            setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht! |]
            redirect $ CourseListTermR $ cfTerm res
        | fAct == formActionSave 
        , Just cid <- cfCourseId res -> do 
            actTime <- liftIO getCurrentTime
            runDB $ do
              update cid 
                [ CourseName         =. cfName     res
                , CourseDescription  =. cfDesc     res
                , CourseLinkExternal =. cfLink     res
                , CourseSchoolId     =. cfSchool   res
                , CourseCapacity     =. cfCapacity res
                , CourseRegisterFrom =. cfRegFrom  res
                , CourseRegisterTo   =. cfRegTo    res
                , CourseChangedBy    =. aid
                , CourseChanged      =. actTime
                ]
            let cti = termToText $ cfTerm res
            setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
            redirect $ CourseListTermR $ cfTerm res
        | 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          = TermKey $ 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 = termToText $ cfTerm res
                  setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde angelegt. |]
                  redirect $ CourseListTermR $ cfTerm res
                Nothing -> do
                  let cti = termToText $ cfTerm res
                  setMessage $ [shamlet|
                      <div .alert .alert-danger>
                        Es gibt bereits einen Kurs #{cfShort res} in Semester #{cti}. 
                    |]      
      (FormFailure _,_) -> setMessage "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     :: TermIdentifier
        , 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     = unTermKey $ 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 html = do       
    -- mopt hiddenField    
--     cidKey <- getsYesod appCryptoIDKey
--     courseId <- runMaybeT $ do
--         cid <- cfCourseId template
--         UUID.encrypt cidKey cid 
    (result, widget) <- flip (renderBootstrap3 bsHorizontalDefault) html $ CourseForm
      -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
      <$> aopt hiddenField "KursId"             (cfCourseId <$> template)
      <*> areq textField (set "Name")           (cfName     <$> template)
      <*> aopt htmlField (set "Beschreibung")   (cfDesc     <$> template)
      <*> aopt urlField  (set "Homepage")       (cfLink     <$> template)
      <*> areq textField (setToolt "Kürzel" "Muss innerhalb des Semesters eindeutig sein")       (cfShort  <$> template)
      <*> areq termExistsField        (set "Semester")       (cfTerm     <$> template)
      <*> areq (selectField schools)  (set "Institut")       (cfSchool   <$> template)
      <*> aopt (natField "Kapazität") (set "Kapazität")      (cfCapacity <$> template)
      <*> areq checkBoxField          (set "Anmeldung")      (cfHasReg   <$> template)
      <*> aopt utcTimeField           (set "Anmeldung von:") (cfRegFrom  <$> template)
      <*> aopt utcTimeField           (set "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
    
    set :: Text -> FieldSettings site 
    set = bfs 

    setAttrs :: Text -> [(Text,Text)] -> FieldSettings site 
    setAttrs t attrs = 
      let ifs = bfs t in ifs { fsAttrs= attrs++(fsAttrs ifs) }
          
    setToolt :: Text -> String -> FieldSettings site
    setToolt t tt =
      let ifs = bfs t in ifs { fsTooltip= Just $ fromString tt }
          
--     schools :: GHandler UniWorX UniWorX (OptionList SchoolId)
    schools = do
        entities <- runDB $ selectList [] [Asc SchoolShorthand]
        optionsPairs $ map (\school -> (schoolShorthand $ entityVal school, entityKey school)) entities
                           
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"
      )
  ] ]