module Handler.Tutorial.Form
  ( TutorialForm(..)
  , tutorialForm
  ) where

import Import
import Handler.Utils
import Handler.Utils.Form.Occurrences

import qualified Database.Esqueleto as E

import Data.Map ((!))
import qualified Data.Set as Set

import qualified Data.CaseInsensitive as CI


data TutorialForm = TutorialForm
  { tfName            :: TutorialName
  , tfType            :: CI Text
  , tfRegGroup        :: Maybe (CI Text)
  , tfTutorControlled :: Bool
  , tfCapacity        :: Maybe Int
  , tfRoom            :: Maybe Text
  , tfTime            :: Occurrences
  , tfRegisterFrom    :: Maybe UTCTime
  , tfRegisterTo      :: Maybe UTCTime
  , tfDeregisterUntil :: Maybe UTCTime
  , tfTutors          :: Set (Either UserEmail UserId)
  }

tutorialForm :: CourseId -> Maybe TutorialForm -> Form TutorialForm
tutorialForm cid template html = do
  MsgRenderer mr <- getMsgRenderer
  cRoute <- fromMaybe (error "tutorialForm called from 404-Handler") <$> getCurrentRoute
  uid <- liftHandler requireAuthId

  let
    tutorForm = Set.fromList <$> massInputAccumA miAdd' miCell' (\p -> Just . SomeRoute $ cRoute :#: p) miLayout' ("tutors" :: Text) (fslI MsgTutorialTutors) False (Set.toList . tfTutors <$> template)
      where
        miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
        miAdd' nudge submitView csrf = do
          (addRes, addView) <- mpreq (multiUserField False . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
          let
            addRes'
              | otherwise
              = addRes <&> \newDat oldDat -> if
                  | existing <- newDat `Set.intersection` Set.fromList oldDat
                  , not $ Set.null existing
                    -> FormFailure [mr MsgTutorialTutorAlreadyAdded]
                  | otherwise
                    -> FormSuccess $ Set.toList newDat
          return (addRes', $(widgetFile "tutorial/tutorMassInput/add"))


        miCell' :: Either UserEmail UserId -> Widget
        miCell' (Left email) = do
          invWarnMsg <- messageI Warning MsgEmailInvitationWarning
          $(widgetFile "tutorial/tutorMassInput/cellInvitation")
        miCell' (Right userId) = do
          User{..} <- liftHandler . runDB $ get404 userId
          $(widgetFile "tutorial/tutorMassInput/cellKnown")

        miLayout' :: MassInputLayout ListLength (Either UserEmail UserId) ()
        miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "tutorial/tutorMassInput/layout")

  flip (renderAForm FormStandard) html $ TutorialForm
    <$> areq (textField & cfStrip & cfCI) (fslpI MsgTutorialName (mr MsgTutorialName) & setTooltip MsgTutorialNameTip) (tfName <$> template)
    <*> areq (textField & cfStrip & cfCI & addDatalist tutTypeDatalist) (fslpI MsgTutorialType (mr MsgTutorialTypePlaceholder) & setTooltip MsgTutorialTypeTip) (tfType <$> template)
    <*> aopt (textField & cfStrip & cfCI) (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial"))
    <*> apopt checkBoxField (fslI MsgTutorialTutorControlled & setTooltip MsgTutorialTutorControlledTip) (tfTutorControlled <$> template)
    <*> aopt (natFieldI MsgTutorialCapacityNonPositive) (fslpI MsgTutorialCapacity (mr MsgTutorialCapacity) & setTooltip MsgTutorialCapacityTip) (tfCapacity <$> template)
    <*> (assertM (not . null) <$> aopt (textField & cfStrip) (fslpI MsgTutorialRoom $ mr MsgTutorialRoomPlaceholder) (tfRoom <$> template))
    <*> occurrencesAForm ("occurrences" :: Text) (tfTime <$> template)
    <*> aopt utcTimeField   (fslpI MsgRegisterFrom (mr MsgDate)
                               & setTooltip MsgCourseRegisterFromTip
                            ) (tfRegisterFrom <$> template)
    <*> aopt utcTimeField   (fslpI MsgRegisterTo   (mr MsgDate)
                               & setTooltip MsgCourseRegisterToTip
                            ) (tfRegisterTo <$> template)
    <*> aopt utcTimeField   (fslpI MsgDeRegUntil   (mr MsgDate)
                               & setTooltip MsgCourseDeregisterUntilTip
                            ) (tfDeregisterUntil <$> template)
    <*> tutorForm
  where
    tutTypeDatalist :: HandlerFor UniWorX (OptionList (CI Text))
    tutTypeDatalist = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $
      fmap (setOf $ folded . _Value) . E.select . E.from $ \tutorial -> do
        E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
        return $ tutorial E.^. TutorialType

    tutUserSuggestions :: UserId -> E.SqlQuery (E.SqlExpr (Entity User))
    tutUserSuggestions uid = E.from $ \(lecturer `E.InnerJoin` course `E.InnerJoin` tutorial `E.InnerJoin` tutor `E.InnerJoin` tutorUser) -> do
      E.on $ tutorUser E.^. UserId E.==. tutor E.^. TutorUser
      E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
      E.on $ tutorial E.^. TutorialCourse E.==. course E.^. CourseId
      E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
      E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
      return tutorUser