module Handler.School where

import Import
import Handler.Utils

import qualified Database.Esqueleto.Legacy as E

import qualified Data.Set as Set
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as Text


getSchoolListR :: Handler Html
getSchoolListR = do
  let
    schoolLink :: SchoolId -> SomeRoute UniWorX
    schoolLink ssh = SomeRoute $ SchoolR ssh SchoolEditR

    dbtSQLQuery :: E.SqlExpr (Entity School) -> E.SqlQuery _
    dbtSQLQuery = return

    dbtProj = dbtProjId

    dbtRowKey = (E.^. SchoolId)

    dbtColonnade :: Colonnade Sortable _ _
    dbtColonnade = mconcat
      [ colSchoolShort $ _dbrOutput . _entityKey
      , anchorColonnade (views (_dbrOutput . _entityKey) schoolLink) $ colSchoolName (_dbrOutput . _entityVal . _schoolName)
      ]

    dbtSorting = mconcat
      [ sortSchoolShort $ to (E.^. SchoolId)
      , sortSchoolName $ to (E.^. SchoolName)
      ]

    dbtFilter = mempty
    dbtFilterUI = mempty

    dbtStyle = def
    dbtParams = def

    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing
  
    dbtExtraReps = []

    dbtIdent :: Text
    dbtIdent = "schools"

    psValidator = def
      & defaultSorting [SortAscBy "school-name"]


  table <- runDB $ dbTableWidget' psValidator DBTable{..}

  let title = MsgHeadingSchoolList
  siteLayoutMsg title $ do
    setTitleI title
    table

data SchoolForm = SchoolForm
  { sfShorthand :: CI Text
  , sfName :: CI Text
  , sfOrgUnits :: Set (CI Text)
  , sfExamMinimumRegisterBeforeStart
  , sfExamMinimumRegisterDuration :: Maybe NominalDiffTime
  , sfExamRequireModeForRegistration :: Bool
  , sfExamDiscouragedModes :: ExamModeDNF
  , sfExamCloseMode :: ExamCloseMode
  , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode
  , sfSheetAuthorshipStatementDefinition :: Maybe I18nStoredMarkup
  , sfSheetAuthorshipStatementAllowOther :: Bool
  , sfSheetExamAuthorshipStatementMode :: SchoolAuthorshipStatementMode
  , sfSheetExamAuthorshipStatementDefinition :: Maybe I18nStoredMarkup
  , sfSheetExamAuthorshipStatementAllowOther :: Bool
  }

mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
  <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh (textField & cfStrip & cfCI) (fslI MsgSchoolShort)
  <*> areq (textField & cfStrip & cfCI) (fslI MsgSchoolName) (sfName <$> template)
  <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") MsgSchoolLdapOrganisationMissing (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template))
  <*  aformSection MsgSchoolExamSection
  <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterBeforeStart & setTooltip MsgSchoolExamMinimumRegisterBeforeStartTip) (sfExamMinimumRegisterBeforeStart <$> template)
  <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template)
  <*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template)
  <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse)))
  <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate)
  <*  aformSection MsgSchoolAuthorshipStatementSection
  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
  <*> i18nFieldA htmlField False (\_ -> Nothing) ("sheet-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) False (sfSheetAuthorshipStatementDefinition <$> template)
  <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True)
  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
  <*> i18nFieldA htmlField False (\_ -> Nothing) ("exam-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) False (sfSheetExamAuthorshipStatementDefinition <$> template)
  <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True)
  -- TODO(AuthorshipStatements): disallow not allowOther && is _Nothing definition
  where
    ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text))
    ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $
      setOf (folded . _entityVal . _schoolLdapOrgUnit) <$> selectList [] []

schoolToForm :: SchoolId -> DB (Form SchoolForm)
schoolToForm ssh = do
  School{..} <- get404 ssh
  ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] []

  mSheetAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetAuthorshipStatementDefinition
  mSheetExamAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetExamAuthorshipStatementDefinition

  return . mkSchoolForm (Just ssh) $ Just SchoolForm
    { sfShorthand = schoolShorthand
    , sfName = schoolName
    , sfOrgUnits = setOf (folded . _entityVal . _schoolLdapOrgUnit) ldapFrags
    , sfExamMinimumRegisterBeforeStart = schoolExamMinimumRegisterBeforeStart
    , sfExamMinimumRegisterDuration = schoolExamMinimumRegisterDuration
    , sfExamRequireModeForRegistration = schoolExamRequireModeForRegistration
    , sfExamDiscouragedModes = schoolExamDiscouragedModes
    , sfExamCloseMode = schoolExamCloseMode
    , sfSheetAuthorshipStatementMode = schoolSheetAuthorshipStatementMode
    , sfSheetAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetAuthorshipStatementDefinition
    , sfSheetAuthorshipStatementAllowOther = schoolSheetAuthorshipStatementAllowOther
    , sfSheetExamAuthorshipStatementMode = schoolSheetExamAuthorshipStatementMode
    , sfSheetExamAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetExamAuthorshipStatementDefinition
    , sfSheetExamAuthorshipStatementAllowOther = schoolSheetExamAuthorshipStatementAllowOther
    }

getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html
getSchoolEditR = postSchoolEditR
postSchoolEditR ssh = do
  sForm <- runDB $ schoolToForm ssh

  ((sfResult, sfView), sfEnctype) <- runFormPost sForm

  formResult sfResult $ \SchoolForm{..} -> do
    runDB $ do
      mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetAuthorshipStatementDefinition
      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
      update ssh
        [ SchoolName =. sfName
        , SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart
        , SchoolExamMinimumRegisterDuration =. sfExamMinimumRegisterDuration
        , SchoolExamRequireModeForRegistration =. sfExamRequireModeForRegistration
        , SchoolExamDiscouragedModes =. sfExamDiscouragedModes
        , SchoolExamCloseMode =. sfExamCloseMode
        , SchoolSheetAuthorshipStatementMode =. sfSheetAuthorshipStatementMode
        , SchoolSheetAuthorshipStatementDefinition =. mSheetAuthorshipStatementId
        , SchoolSheetAuthorshipStatementAllowOther =. sfSheetAuthorshipStatementAllowOther
        , SchoolSheetExamAuthorshipStatementMode =. sfSheetExamAuthorshipStatementMode
        , SchoolSheetExamAuthorshipStatementDefinition =. mSheetExamAuthorshipStatementId
        , SchoolSheetExamAuthorshipStatementAllowOther =. sfSheetExamAuthorshipStatementAllowOther
        ]
      forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
        void $ upsert SchoolLdap
          { schoolLdapSchool = Just ssh
          , ..
          }
          [ SchoolLdapSchool =. Just ssh
          ]
      deleteWhere [SchoolLdapSchool ==. Just ssh, SchoolLdapOrgUnit /<-. Set.toList sfOrgUnits]
      addMessageI Success $ MsgSchoolUpdated ssh
    redirect $ SchoolR ssh SchoolEditR

  let sfView' = wrapForm sfView FormSettings
        { formMethod = POST
        , formAction = Just . SomeRoute $ SchoolR ssh SchoolEditR
        , formEncoding = sfEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formAnchor = Nothing :: Maybe Text
        }

  siteLayoutMsg (MsgSchoolTitle ssh) $ do
    setTitleI $ MsgSchoolTitle ssh
    sfView'

getSchoolNewR, postSchoolNewR :: Handler Html
getSchoolNewR = postSchoolNewR
postSchoolNewR = do
  uid <- requireAuthId
  ((sfResult, sfView), sfEnctype) <- runFormPost $ mkSchoolForm Nothing Nothing

  formResult sfResult $ \SchoolForm{..} -> do
    let ssh = SchoolKey sfShorthand
    insertOkay <- runDB $ do
      mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
      didInsert <- is _Just <$> insertUnique School
        { schoolShorthand = sfShorthand
        , schoolName = sfName
        , schoolExamMinimumRegisterBeforeStart = sfExamMinimumRegisterBeforeStart
        , schoolExamMinimumRegisterDuration = sfExamMinimumRegisterDuration
        , schoolExamRequireModeForRegistration = sfExamRequireModeForRegistration
        , schoolExamDiscouragedModes = sfExamDiscouragedModes
        , schoolExamCloseMode = sfExamCloseMode
        , schoolSheetAuthorshipStatementMode = sfSheetAuthorshipStatementMode
        , schoolSheetAuthorshipStatementDefinition = mSheetAuthorshipStatementId
        , schoolSheetAuthorshipStatementAllowOther = sfSheetAuthorshipStatementAllowOther
        , schoolSheetExamAuthorshipStatementMode = sfSheetExamAuthorshipStatementMode
        , schoolSheetExamAuthorshipStatementDefinition = mSheetExamAuthorshipStatementId
        , schoolSheetExamAuthorshipStatementAllowOther = sfSheetExamAuthorshipStatementAllowOther
        }
      when didInsert $ do
        insert_ UserFunction
          { userFunctionUser     = uid
          , userFunctionSchool   = ssh
          , userFunctionFunction = SchoolAdmin
          }
        forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
          void $ upsert SchoolLdap
            { schoolLdapSchool = Just ssh
            , ..
            }
            [ SchoolLdapSchool =. Just ssh
            ]
      return didInsert

    if
      | insertOkay -> do
          addMessageI Success $ MsgSchoolCreated ssh
          redirect $ SchoolR ssh SchoolEditR
      | otherwise
        -> addMessageI Error $ MsgSchoolExists ssh

  let sfView' = wrapForm sfView FormSettings
        { formMethod = POST
        , formAction = Just $ SomeRoute SchoolNewR
        , formEncoding = sfEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formAnchor = Nothing :: Maybe Text
        }

  siteLayoutMsg MsgTitleSchoolNew $ do
    setTitleI MsgTitleSchoolNew
    sfView'