-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.AuthorshipStatement
  ( insertAuthorshipStatement
  , forcedAuthorshipStatementField
  , authorshipStatementWidget
  , getSheetAuthorshipStatement
  , acceptAuthorshipStatementField
  ) where

import Import
import Utils.Form

import qualified Data.Map.Strict as Map

import Handler.Utils.Form (i18nLangMap, I18nLang(..))

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E

import qualified Data.ByteString.Base64.URL as Base64
import qualified Data.ByteArray as BA


insertAuthorshipStatement :: MonadIO m
                          => I18nStoredMarkup -> SqlWriteT m AuthorshipStatementDefinitionId
insertAuthorshipStatement authorshipStatementDefinitionContent = withCompatibleBackend @SqlBackend $ do
  let authorshipStatementDefinitionHash = toAuthorshipStatementReference authorshipStatementDefinitionContent
  unlessM (exists [AuthorshipStatementDefinitionHash ==. authorshipStatementDefinitionHash]) $
    insert_ AuthorshipStatementDefinition{..}
  return $ AuthorshipStatementDefinitionKey authorshipStatementDefinitionHash

forcedAuthorshipStatementField :: (MonadHandler handler, HandlerSite handler ~ UniWorX)
                               => Field handler AuthorshipStatementDefinition
forcedAuthorshipStatementField = Field{..}
  where
    fieldParse _ _ = pure . Left $ SomeMessage ("Result of forcedAuthorshipStatementField inspected" :: Text)
    fieldEnctype = UrlEncoded
    fieldView theId _name attrs (preview _Right -> mVal) _isReq
      = [whamlet|
          $newline never
          <div ##{theId} *{attrs}>
            ^{maybe mempty authorshipStatementWidget mVal}
        |]

authorshipStatementWidget :: AuthorshipStatementDefinition -> Widget
authorshipStatementWidget AuthorshipStatementDefinition{..}
  = [whamlet|
      $newline never
      <dl .authorship-statement>
        $forall (I18nLang l, t) <- Map.toList (review i18nLangMap authorshipStatementDefinitionContent)
          <dt>
            _{MsgLanguageEndonym l}
          <dd>
            #{markupOutput t}

      <p .authorship-statement__id>
        #{hashText}
    |]
  where hashText = decodeUtf8 . Base64.encodeUnpadded $ BA.convert authorshipStatementDefinitionHash

acceptAuthorshipStatementField :: forall m.
                                  (MonadHandler m, HandlerSite m ~ UniWorX)
                               => Entity AuthorshipStatementDefinition
                               -> Field m AuthorshipStatementDefinitionId
acceptAuthorshipStatementField (Entity asdId asd)
    = checkBoxField
    & _fieldView %~ adjFieldView
    & checkMap (bool (Left MsgAuthorshipStatementStatementIsRequired) (Right asdId)) (== asdId)
  where
    adjFieldView :: FieldViewFunc m Bool -> FieldViewFunc m Bool
    adjFieldView checkboxView theId theName attrs val isReq = do
      let checkboxWdgt = checkboxView checkboxId theName [] val isReq
          checkboxId = theId <> "__checkbox"
      $(widgetFile "widgets/authorship-statement-accept")


getSheetAuthorshipStatement :: MonadIO m
                            => Entity Sheet
                            -> SqlReadT m (Maybe (Entity AuthorshipStatementDefinition))
getSheetAuthorshipStatement (Entity _ Sheet{..}) = withCompatibleBackend @SqlBackend $ traverse getJustEntity <=< runMaybeT $ do
  Entity _ School{..} <- MaybeT . E.selectMaybe . E.from $ \(school `E.InnerJoin` course) -> do
    E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
    E.where_ $ course E.^. CourseId E.==. E.val sheetCourse
    return school

  let examId = fmap Right sheetAuthorshipStatementExam
           <|> fmap Left (sheetType ^? _examPart . re _SqlKey)
           <|> fmap Right sheetRequireExamRegistration
  exam <- lift . for examId $ \case
    Right e -> getJust e
    Left epId -> getJust epId >>= getJust . examPartExam

  let
    examAuthorshipStatement' = exam >>= examAuthorshipStatement
    sheetAuthorshipStatement' = guardOnM (is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode) sheetAuthorshipStatement
    sheetDoAuthorshipStatements
      =     is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode
        || (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode && is _Just examAuthorshipStatement')

  if
    | is _Just exam
    , is _SchoolAuthorshipStatementModeNone schoolSheetExamAuthorshipStatementMode
      -> mzero
    | is _Just exam
    , not schoolSheetExamAuthorshipStatementAllowOther
      -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetExamAuthorshipStatementDefinition
    | is _Just exam
    , is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode
      -> hoistMaybe $ sheetAuthorshipStatement'
                  <|> guardOnM (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode) examAuthorshipStatement'
                  <|> schoolSheetExamAuthorshipStatementDefinition

    | is _Nothing exam
    , is _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode
      -> mzero
    | is _Nothing exam
    , not schoolSheetAuthorshipStatementAllowOther
      -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetAuthorshipStatementDefinition
    | is _Nothing exam
    , is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode
      -> hoistMaybe $ sheetAuthorshipStatement' <|> schoolSheetAuthorshipStatementDefinition

    | otherwise
      -> case exam of
           Just _  -> hoistMaybe $ sheetAuthorshipStatement' <|> examAuthorshipStatement'
           Nothing -> hoistMaybe   sheetAuthorshipStatement'