-- SPDX-FileCopyrightText: 2025 Steffen Jost <S.Jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
{-# LANGUAGE TypeApplications #-}

module Handler.Qualification.Edit
  ( getQualificationNewR,  postQualificationNewR
  , getQualificationEditR, postQualificationEditR
  )
  where

import Import

import qualified Data.Text as Text
import qualified Control.Monad.State.Class as State

import Handler.Utils
-- import           Database.Esqueleto.Experimental ((:&)(..))
-- import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma


getQualificationNewR,  postQualificationNewR :: SchoolId -> Handler Html
getQualificationNewR = postQualificationNewR
postQualificationNewR ssh = handleQualificationEdit ssh Nothing

getQualificationEditR,  postQualificationEditR :: SchoolId -> QualificationShorthand -> Handler Html
getQualificationEditR = postQualificationEditR
postQualificationEditR ssh qsh = do
  qent <- runDBRead $ getBy404 $ SchoolQualificationShort ssh qsh
  handleQualificationEdit ssh $ Just qent


mkQualificationForm :: SchoolId -> Maybe Qualification -> Form Qualification
mkQualificationForm ssh templ = identifyForm FIDQualificationEdit . validateForm (validateQualificationEdit ssh) $ \html ->
    flip (renderAForm FormStandard) html $ reorderedQualification
      <$> areq hiddenField "" (Just ssh)                                                                                                                --  1 ->  1
      <*> areq ciField                                      (fslI MsgQualificationShort)                  (qualificationShorthand           <$> templ)  --  2 ->  2
      <*> areq ciField                                      (fslI MsgQualificationName)                   (qualificationName                <$> templ)  --  3 ->  3
      <*> aopt htmlField                                    (fslI MsgQualificationDescription)            (qualificationDescription         <$> templ)  --  4 ->  4
      <*> aopt_natFieldI                                          MsgQualificationValidDuration           (qualificationValidDuration       <$> templ)  --  5 ->  5
      <*> aopt calendarDiffDaysField                        (fslI MsgQualificationRefreshWithin &
                                                      setTooltip  MsgQualificationRefreshWithinTooltip)   (qualificationRefreshWithin       <$> templ)  --  6 ->  7

      <*> areq checkBoxField                                (fslI MsgQualificationElearningStart)         (qualificationElearningStart      <$> templ)  --  7 ->  9
      <*> aopt calendarDiffDaysField                        (fslI MsgQualificationRefreshReminder &
                                                      setTooltip  MsgQualificationRefreshReminderTooltip) (qualificationRefreshReminder     <$> templ)  --  8 -> 8
      <*> areq checkBoxField                                (fslI MsgQualificationExpiryNotification)     (qualificationExpiryNotification  <$> templ)  --  9 -> 13
      <*> areq_natFieldI                                          MsgQualificationAuditDuration           (qualificationAuditDuration       <$> templ)  -- 10 -> 6
      <*> areq checkBoxField                                (fslI MsgQualificationElearningRenew)         (qualificationElearningRenews     <$> templ)  -- 11 -> 10
      <*> aopt_natFieldI                                          MsgQualificationElearningLimit          (qualificationElearningLimit      <$> templ)  -- 12 -> 11
      <*> aopt qualificationField                           (fslI MsgTableQualificationLmsReuses &
                                                      setTooltip  MsgTableQualificationLmsReusesTooltip)  (qualificationLmsReuses           <$> templ)  -- 13 -> 12
      <*> aopt avsLicenceField                              (fslI MsgQualificationAvsLicence &
                                                  setTooltip MsgTableQualificationIsAvsLicenceTooltip)    (qualificationAvsLicence          <$> templ)  -- 14 -> 14
      <*> aopt textField                                    (fslI MsgQualificationSapId &
                                                  setTooltip MsgTableQualificationSapExportTooltip)       (qualificationSapId               <$> templ)  -- 15 -> 15
  where
    avsLicenceField :: Field Handler AvsLicence
    avsLicenceField = selectFieldList [ (Text.singleton $ licence2char lic, lic) | lic <- universeF, lic /= AvsNoLicence ]

    aopt_natFieldI msg = aopt (natFieldI $ SomeMessages " " [SomeMessage msg, SomeMessage MsgMustBePositive]) (fslI msg)
    areq_natFieldI msg = areq (natFieldI $ SomeMessages " " [SomeMessage msg, SomeMessage MsgMustBePositive]) (fslI msg)
                                       -- [ 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15]
    reorderedQualification = $(permuteFun [ 1, 2, 3, 4, 5,10, 6, 8, 7,11,12,13, 9,14,15]) Qualification --  == inversePermutation [1,2,3,4,5,7,9,8,13,6,10,11,12,14,15]

validateQualificationEdit :: SchoolId -> FormValidator Qualification Handler ()
validateQualificationEdit ssh = do
    canonise
    Qualification{..} <- State.get
    guardValidation MsgQualFormErrorSshMismatch             $ qualificationSchool == ssh
    guardValidation MsgLmsErrorNoRefreshElearning           $ not qualificationElearningStart || isJust qualificationRefreshWithin
    guardValidation MsgLmsErrorNoRenewElearning             $ not qualificationElearningStart || isJust qualificationValidDuration
    when (isJust qualificationLmsReuses) $
      liftHandler $ addMessageI Info MsgQualificationAuditDurationReuseInfo
  where
    canonise = do --  i.e. map Just 0 to Nothing
      Qualification{..} <- State.get
      -- canonisation, i.e. map Just 0 to Nothing
      when (qualificationRefreshWithin   == Just mempty) $ State.modify $ set _qualificationRefreshWithin   Nothing
      when (qualificationRefreshReminder == Just mempty) $ State.modify $ set _qualificationRefreshReminder Nothing
      when (qualificationValidDuration   == Just      0) $ State.modify $ set _qualificationValidDuration   Nothing
      when (qualificationElearningLimit  == Just      0) $ State.modify $ set _qualificationElearningLimit  Nothing



handleQualificationEdit :: SchoolId -> Maybe (Entity Qualification) -> Handler Html
handleQualificationEdit ssh templ = do
  ((qRes, qWgt), qEnc) <- runFormPost $ mkQualificationForm ssh $ entityVal <$> templ
  let qForm = wrapForm qWgt def
                { formEncoding = qEnc
                }
  formResult qRes $ \resQuali -> do
    uniqViolation <- runDB $ case templ of
      Just Entity{entityKey=qid} -> replaceUnique qid resQuali                                -- edit old qualification
      _ -> maybeM (checkUnique resQuali) (const $ return Nothing) (insertUnique resQuali)     -- insert new qualification
    case uniqViolation of
      Just (SchoolQualificationShort _ nconflict) -> addMessageI Error $ MsgQualFormErrorDuplShort $ ciOriginal nconflict
      Just (SchoolQualificationName  _ nconflict) -> addMessageI Error $ MsgQualFormErrorDuplName  $ ciOriginal nconflict
      Nothing -> do
        let qshort = qualificationShorthand resQuali
            qmsg   = if isNothing templ then MsgQualificationCreated else MsgQualificationEdit
        addMessageI Success $ qmsg $ ciOriginal qshort
        redirect $ QualificationR ssh qshort
  let heading = bool MsgMenuQualificationNew MsgMenuQualificationEdit $ isJust templ
  siteLayoutMsg heading $ do
    setTitleI heading
    [whamlet|
      <p>
        ^{qForm}
      $maybe _ <- templ
        <p>
          _{MsgQualificationEditNote}
    |]