module Handler.ExamOffice.Fields
  ( getEOFieldsR
  , postEOFieldsR
  ) where

import Import
import Utils.Form

import qualified Database.Esqueleto as E

import qualified Data.Set as Set
import qualified Data.Map as Map


data ExamOfficeFieldMode
  = EOFNotSubscribed
  | EOFSubscribed
  | EOFForced
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
embedRenderMessage ''UniWorX ''ExamOfficeFieldMode $ concat . set (ix 0) "ExamOfficeField" . splitCamel
instance Universe ExamOfficeFieldMode
instance Finite ExamOfficeFieldMode
nullaryPathPiece ''ExamOfficeFieldMode $ camelToPathPiece' 1
instance Default ExamOfficeFieldMode where
  def = EOFNotSubscribed

eofModeField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m ExamOfficeFieldMode
-- ^ Always required
eofModeField = Field{..}
  where
    fieldEnctype = UrlEncoded
    fieldView = \theId name attrs val _isReq -> $(widgetFile "widgets/fields/examOfficeFieldMode")
    fieldParse = \e _ -> return $ parser e

    parser [] = Right Nothing
    parser (x:_)
      | Just mode <- fromPathPiece x
      = Right $ Just mode
    parser (x:_)
      = Left . SomeMessage $ MsgInvalidExamOfficeFieldMode x

    isChecked :: Eq a => a -> Either Text a -> Bool
    isChecked opt = either (const False) (== opt)


makeExamOfficeFieldsForm :: UserId -> Maybe (Map StudyTermsId Bool) -> Form (Map StudyTermsId Bool)
makeExamOfficeFieldsForm uid template = renderWForm FormStandard $ do
  availableFields <- liftHandler . runDB . E.select . E.from $ \(terms `E.InnerJoin` schoolTerms) -> do
    E.on $ terms E.^. StudyTermsId E.==. schoolTerms E.^. SchoolTermsTerms
    E.where_ . E.exists . E.from $ \userFunction ->
      E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
           E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
           E.&&. userFunction E.^. UserFunctionSchool E.==. schoolTerms E.^. SchoolTermsSchool
    return terms
  let available = imap (\k terms -> (terms, view forced $ template >>= Map.lookup k)) $ toMapOf (folded .> _entityVal) availableFields

      forced :: Iso' (Maybe Bool) ExamOfficeFieldMode
      forced = iso fromForced toForced
        where
          fromForced = maybe EOFNotSubscribed $ bool EOFSubscribed EOFForced
          toForced = \case
            EOFNotSubscribed -> Nothing
            EOFSubscribed    -> Just False
            EOFForced        -> Just True

  fmap (fmap (Map.mapMaybe $ review forced) . sequence) . forM available $ \(StudyTerms{..}, template')
    -> let label = fromMaybe (tshow studyTermsKey) $ studyTermsName <|> studyTermsShorthand
        in wpopt eofModeField (fsl label) $ Just template'

-- | Manage the list of `StudyTerms` this user (in her function as exam-office)
--   has an interest in, i.e. that authorize her to view an users grades, iff
--   they study one of the selected fields
getEOFieldsR, postEOFieldsR :: Handler Html
getEOFieldsR = postEOFieldsR
postEOFieldsR = do
  uid <- requireAuthId

  oldFields <- runDB $ do
    fields <- E.select . E.from $ \examOfficeField -> do
      E.where_ $ examOfficeField E.^. ExamOfficeFieldOffice E.==. E.val uid
      return (examOfficeField E.^. ExamOfficeFieldField, examOfficeField E.^. ExamOfficeFieldForced)
    return $ toMapOf (folded .> ito (over _1 E.unValue . over _2 E.unValue)) fields

  ((fieldsRes, fieldsView), fieldsEnc) <- runFormPost . makeExamOfficeFieldsForm uid $ Just oldFields

  formResult fieldsRes $ \newFields -> do
    runDB . forM_ (Map.keysSet newFields `Set.union` Map.keysSet oldFields) $ \fieldId -> if
      | Just forced <- Map.lookup fieldId newFields
      , fieldId `Map.member` oldFields -> do
          updateBy (UniqueExamOfficeField uid fieldId) [ ExamOfficeFieldForced =. forced ]
          audit $ TransactionExamOfficeFieldEdit uid fieldId
      | Just forced <- Map.lookup fieldId newFields -> do
          insert_ $ ExamOfficeField uid fieldId forced
          audit $ TransactionExamOfficeFieldEdit uid fieldId
      | otherwise -> do
          deleteBy $ UniqueExamOfficeField uid fieldId
          audit $ TransactionExamOfficeFieldDelete uid fieldId
    addMessageI Success $ MsgTransactionExamOfficeFieldsUpdated (Set.size . Set.map (view _1) $ (setSymmDiff `on` assocsSet) newFields oldFields)
    redirect $ ExamOfficeR EOExamsR

  let
    fieldsView' = wrapForm fieldsView def
      { formAction = Just . SomeRoute $ ExamOfficeR EOFieldsR
      , formEncoding = fieldsEnc
      }

  siteLayoutMsg MsgMenuExamOfficeFields $ do
    setTitleI MsgMenuExamOfficeFields

    [whamlet|
      $newline never
      <p>
        _{MsgExamOfficeSubscribedFieldsExplanation}
      ^{fieldsView'}
    |]