-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
Module: Model.Types.Exam
Description: Types for modeling Exams
-}
module Model.Types.Exam
  ( ExamResult'(..)
  , _ExamAttended, _ExamNoShow, _ExamVoided
  , _examResult
  , ExamBonusRule(..)
  , ExamOccurrenceRule(..)
  , examOccurrenceRuleAutomatic
  , ExamOccurrenceMappingDescription(..)
  , _eaomrStart, _eaomrEnd, _eaomrSpecial
  , _ExamOccurrenceMappingRange, _ExamOccurrenceMappingSpecial
  , ExamOccurrenceMapping(..)
  , _examOccurrenceMappingRule
  , _examOccurrenceMappingMapping
  , traverseExamOccurrenceMapping
  , ExamOccurrenceCapacity(.., Unrestricted, Restricted)
  , _examOccurrenceCapacityIso
  , ExamGrade(..)
  , numberGrade
  , ExamGradeDefCenter(..)
  , ExamGradingRule(..)
  , ExamPassed(..)
  , passingGrade
  , ExamResultPoints, ExamResultGrade, ExamResultPassed
  , ExamResultPassedGrade
  , ExamGradingMode(..)
  , _ExamGradingPass, _ExamGradingGrades, _ExamGradingMixed
  , hasExamGradingPass, hasExamGradingGrades
  , ExamPartNumber
  , _ExamPartNumber, _ExamPartNumber'
  , ExamAids(..), ExamAidsPreset(..)
  , ExamOnline(..), ExamOnlinePreset(..)
  , ExamSynchronicity(..), ExamSynchronicityPreset(..)
  , ExamRequiredEquipment(..), ExamRequiredEquipmentPreset(..)
  , ExamMode(..)
  , ExamModePredicate(..), ExamModeDNF(..)
  , ExamCloseMode(..), _ExamCloseSeparate, _ExamCloseOnFinished, _ExamCloseOnFinished', _ExamCloseOnFinishedHidden, _examCloseOnFinishedHidden
  ) where

import Import.NoModel
import Model.Types.Common
import Model.Types.TH.PathPiece
import Model.Types.Markup

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

import Utils.Lens.TH

import qualified Data.Csv as Csv

import Database.Persist.Sql

import qualified Data.CaseInsensitive as CI
import qualified Data.Char as Char

import Text.Read

import Text.Blaze (ToMarkup(..))

import qualified Data.Foldable

import Data.Aeson (genericToJSON, genericParseJSON)

import Model.Types.Security

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}


data ExamResult' res = ExamAttended { examResult :: res }
                     | ExamNoShow
                     | ExamVoided
  deriving (Show, Read, Eq, Ord, Functor, Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , fieldLabelModifier = camelToPathPiece' 1
  , omitNothingFields = True
  , sumEncoding = TaggedObject "status" "result"
  } ''ExamResult'
derivePersistFieldJSON ''ExamResult'

makeLenses_ ''ExamResult'
makePrisms ''ExamResult'

instance PathPiece res => PathPiece (ExamResult' res) where
  toPathPiece ExamAttended{..} = toPathPiece examResult
  toPathPiece ExamNoShow       = "no-show"
  toPathPiece ExamVoided       = "voided"

  fromPathPiece t
    | t == "no-show" = Just ExamNoShow
    | t == "voided"  = Just ExamVoided
    | Just examResult <- fromPathPiece t
    = Just ExamAttended{..}
    | otherwise = Nothing

instance Applicative ExamResult' where
  pure = ExamAttended
  ExamAttended f <*> ExamAttended x = ExamAttended $ f x
  ExamAttended _ <*> ExamNoShow     = ExamNoShow
  ExamAttended _ <*> ExamVoided     = ExamVoided
  ExamNoShow     <*> _              = ExamNoShow
  ExamVoided     <*> _              = ExamVoided

instance Foldable ExamResult' where
  foldMap = foldMapOf _examResult

instance Traversable ExamResult' where
  traverse = _examResult

instance Semigroup res => Semigroup (ExamResult' res) where
  ExamAttended r <> ExamAttended r' = ExamAttended $ r <> r'
  ExamVoided     <> _               = ExamVoided
  _              <> ExamVoided      = ExamVoided
  _              <> _               = ExamNoShow

instance Monoid res => Monoid (ExamResult' res) where
  mempty = ExamAttended mempty
  ExamAttended r `mappend` ExamAttended r' = ExamAttended $ r `mappend` r'
  ExamVoided     `mappend` _               = ExamVoided
  _              `mappend` ExamVoided      = ExamVoided
  _              `mappend` _               = ExamNoShow

instance Csv.ToField res => Csv.ToField (ExamResult' res) where
  toField ExamVoided = "voided"
  toField ExamNoShow = "no-show"
  toField ExamAttended{..} = Csv.toField examResult

instance Csv.FromField res => Csv.FromField (ExamResult' res) where
  parseField "voided"  = pure ExamVoided
  parseField "no-show" = pure ExamNoShow
  parseField x = ExamAttended <$> Csv.parseField x

instance Universe res => Universe (ExamResult' res) where
  universe = concat
    [ pure ExamVoided
    , pure ExamNoShow
    , ExamAttended <$> universe
    ]
instance Finite res => Finite (ExamResult' res)


data ExamBonusRule = ExamBonusManual
                     { bonusOnlyPassed :: Bool
                     }
                   | ExamBonusPoints
                     { bonusMaxPoints :: Points
                     , bonusOnlyPassed :: Bool
                     , bonusRound :: Points
                     }
  deriving (Show, Read, Eq, Ord, Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  , constructorTagModifier = camelToPathPiece' 1
  , allNullaryToStringTag = False
  , sumEncoding = TaggedObject "rule" "settings"
  , unwrapUnaryRecords = False
  , tagSingleConstructors = True
  } ''ExamBonusRule
derivePersistFieldJSON ''ExamBonusRule

data ExamOccurrenceRule = ExamRoomManual
                        | ExamRoomFifo
                        | ExamRoomSurname
                        | ExamRoomMatriculation
                        | ExamRoomRandom
  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  , constructorTagModifier = camelToPathPiece' 2
  , allNullaryToStringTag = False
  , sumEncoding = TaggedObject "rule" "settings"
  , unwrapUnaryRecords = False
  , tagSingleConstructors = True
  } ''ExamOccurrenceRule
derivePersistFieldJSON ''ExamOccurrenceRule
makePrisms ''ExamOccurrenceRule

examOccurrenceRuleAutomatic :: ExamOccurrenceRule -> Bool
examOccurrenceRuleAutomatic x = any ($ x)
  [ is _ExamRoomSurname
  , is _ExamRoomMatriculation
  , is _ExamRoomRandom
  ]

data ExamOccurrenceMappingDescription
  = ExamOccurrenceMappingRange { eaomrStart, eaomrEnd :: [CI Char] }
  | ExamOccurrenceMappingSpecial { eaomrSpecial :: [CI Char] }
  | ExamOccurrenceMappingRandom
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  , constructorTagModifier = camelToPathPiece' 3
  } ''ExamOccurrenceMappingDescription

makeLenses_ ''ExamOccurrenceMappingDescription
makePrisms ''ExamOccurrenceMappingDescription

data ExamOccurrenceMapping roomId = ExamOccurrenceMapping
  { examOccurrenceMappingRule :: ExamOccurrenceRule
  , examOccurrenceMappingMapping :: Map roomId (Set ExamOccurrenceMappingDescription)
  }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)
instance ToJSONKey roomId => ToJSON (ExamOccurrenceMapping roomId) where
  toJSON = genericToJSON defaultOptions
    { fieldLabelModifier = camelToPathPiece' 3
    , constructorTagModifier = camelToPathPiece' 1
    , tagSingleConstructors = False
    }
instance (FromJSONKey roomId, Ord roomId) => FromJSON (ExamOccurrenceMapping roomId) where
  parseJSON = genericParseJSON defaultOptions
    { fieldLabelModifier = camelToPathPiece' 3
    , constructorTagModifier = camelToPathPiece' 1
    , tagSingleConstructors = False
    }
derivePersistFieldJSON ''ExamOccurrenceMapping

makeLenses_ ''ExamOccurrenceMapping

traverseExamOccurrenceMapping :: Ord roomId'
                              => Traversal (ExamOccurrenceMapping roomId) (ExamOccurrenceMapping roomId') roomId roomId'
traverseExamOccurrenceMapping = _examOccurrenceMappingMapping . iso Map.toList (Map.fromListWith Set.union) . traverse . _1

-- | Natural extended by representation for Infinity.
-- 
-- Maybe doesn't work, because the 'Ord' instance puts 'Nothing' below 0
-- instead of above every other number.
newtype ExamOccurrenceCapacity = EOCapacity (Maybe Natural)
    deriving stock (Show)
    deriving (Eq, Ord) via (NTop (Maybe Natural))

pattern Unrestricted :: ExamOccurrenceCapacity
pattern Unrestricted = EOCapacity Nothing
pattern Restricted :: Natural -> ExamOccurrenceCapacity
pattern Restricted n = EOCapacity (Just n)

{-# COMPLETE Unrestricted, Restricted #-}

-- | Addition monoid with 'Unrestricted' interpreted as infinity.
instance Semigroup ExamOccurrenceCapacity where
  (<>) Unrestricted _b = Unrestricted
  (<>) _a Unrestricted = Unrestricted
  (<>) (Restricted a) (Restricted b) = Restricted $ a + b

-- | Addition monoid with 'Unrestricted' interpreted as infinity.
instance Monoid ExamOccurrenceCapacity where
  mempty = Restricted 0

_examOccurrenceCapacityIso :: Iso' ExamOccurrenceCapacity (Maybe Natural)
_examOccurrenceCapacityIso = iso (\case {Unrestricted -> Nothing; Restricted n -> Just n})
                                  (\case {Nothing -> Unrestricted; Just n -> Restricted n})

data ExamGrade
  = Grade50
  | Grade40
  | Grade37
  | Grade33
  | Grade30
  | Grade27
  | Grade23
  | Grade20
  | Grade17
  | Grade13
  | Grade10
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

numberGrade :: Prism' Rational ExamGrade
numberGrade = prism toNumberGrade fromNumberGrade
  where
    toNumberGrade :: ExamGrade -> Rational
    toNumberGrade = \case
      Grade50 -> 5.0
      Grade40 -> 4.0
      Grade37 -> 3.7
      Grade33 -> 3.3
      Grade30 -> 3.0
      Grade27 -> 2.7
      Grade23 -> 2.3
      Grade20 -> 2.0
      Grade17 -> 1.7
      Grade13 -> 1.3
      Grade10 -> 1.0
    fromNumberGrade :: Rational -> Either Rational ExamGrade
    fromNumberGrade n
      | n >= 100  = fromNumberGrade $ n / 100
      | otherwise = case n of
          5.0 -> Right Grade50
          4.0 -> Right Grade40
          3.7 -> Right Grade37
          3.3 -> Right Grade33
          3.0 -> Right Grade30
          2.7 -> Right Grade27
          2.3 -> Right Grade23
          2.0 -> Right Grade20
          1.7 -> Right Grade17
          1.3 -> Right Grade13
          1.0 -> Right Grade10
          n'  -> Left  n'

instance PathPiece ExamGrade where
  toPathPiece = toPathPiece . (fromRational :: Rational -> Deci) . review numberGrade
  fromPathPiece = preview numberGrade . (toRational :: Deci -> Rational) <=< fromPathPiece

pathPieceJSON ''ExamGrade
pathPieceJSONKey ''ExamGrade

instance Csv.ToField ExamGrade where
  toField = Csv.toField . toPathPiece
instance Csv.FromField ExamGrade where
  parseField x
       = (parse =<< Csv.parseField x)
    <<|> (parse . Text.replace "," "." =<< Csv.parseField x) -- Ugh.
    where parse :: Text -> Csv.Parser ExamGrade
          parse = maybe (fail "Could not decode ExamGrade from Text") return . fromPathPiece
          a <<|> b = a <|> b <|> a

instance PersistField ExamGrade where
  toPersistValue = PersistRational . review numberGrade
  fromPersistValue = maybe (Left "Could not decode Rational to ExamGrade") Right . preview numberGrade <=< fromPersistValue

instance PersistFieldSql ExamGrade where
  sqlType _ = SqlNumeric 2 1

instance Binary ExamGrade


newtype ExamGradeDefCenter = ExamGradeDefCenter { examGradeDefCenter :: Maybe ExamGrade }
  deriving (Eq, Read, Show, Generic)

instance Ord ExamGradeDefCenter where
  ExamGradeDefCenter Nothing <= ExamGradeDefCenter (Just g) = Grade23 <= g
  ExamGradeDefCenter (Just g) <= ExamGradeDefCenter Nothing = g <= Grade27
  ExamGradeDefCenter g <= ExamGradeDefCenter g' = g <= g'


data ExamGradingRule
  = ExamGradingKey
    { examGradingKey :: [Points] -- ^ @[n1, n2, n3, ..., n11]@ means @0 <= p < n1 -> p ~= 5@, @n1 <= p < n2 -> p ~ 4@, @n2 <= p < n3 -> p ~ 3.7@, ..., @n10 <= p -> p ~ 1.0@
    }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 2
  , constructorTagModifier = camelToPathPiece' 2
  , allNullaryToStringTag = False
  , sumEncoding = TaggedObject "rule" "settings"
  , unwrapUnaryRecords = False
  , tagSingleConstructors = True
  } ''ExamGradingRule
derivePersistFieldJSON ''ExamGradingRule


newtype ExamPassed = ExamPassed { examPassed :: Bool }
  deriving (Read, Show, Generic)
  deriving newtype (Eq, Ord, Enum, Bounded, PersistField)
  deriving anyclass (NFData)

instance PersistFieldSql ExamPassed where
  sqlType _ = sqlType $ Proxy @Bool

deriveFinite ''ExamPassed
finitePathPiece ''ExamPassed ["failed", "passed"]
makeWrapped ''ExamPassed
pathPieceCsv ''ExamPassed
pathPieceJSON ''ExamPassed
pathPieceJSONKey ''ExamPassed

passingGrade :: Iso' ExamGrade ExamPassed
-- ^ Improper isomorphism; maps @ExamPassed True@ to `Grade10`
passingGrade = iso (ExamPassed . (>= Grade40)) (bool Grade50 Grade10 . examPassed)


type ExamResultPoints = ExamResult' Points
type ExamResultGrade  = ExamResult' ExamGrade
type ExamResultPassed = ExamResult' ExamPassed

type ExamResultPassedGrade  = ExamResult' (Either ExamPassed ExamGrade)

instance Csv.ToField (Either ExamPassed ExamGrade) where
  toField = either Csv.toField Csv.toField

instance Csv.FromField (Either ExamPassed ExamGrade) where
  parseField x = (Left <$> Csv.parseField x) <|> (Right <$> Csv.parseField x) -- encodings are disjoint

instance PathPiece (Either ExamPassed ExamGrade) where
  toPathPiece = either toPathPiece toPathPiece
  fromPathPiece x = (Left <$> fromPathPiece x) <|> (Right <$> fromPathPiece x)

instance {-# OVERLAPPING #-} ToJSON (Either ExamPassed ExamGrade) where
  toJSON = either toJSON toJSON
  toEncoding = either toEncoding toEncoding

instance {-# OVERLAPPING #-} FromJSON (Either ExamPassed ExamGrade) where
  parseJSON x = (Left <$> parseJSON x) <|> (Right <$> parseJSON x)


data ExamGradingMode
  = ExamGradingPass
  | ExamGradingGrades
  | ExamGradingMixed
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

nullaryPathPiece ''ExamGradingMode $ camelToPathPiece' 2
pathPieceJSON ''ExamGradingMode
pathPieceJSONKey ''ExamGradingMode
derivePersistFieldPathPiece ''ExamGradingMode
makePrisms ''ExamGradingMode

hasExamGradingPass, hasExamGradingGrades :: ExamGradingMode -> Bool
hasExamGradingPass   ExamGradingGrades = False
hasExamGradingPass   _                 = True
hasExamGradingGrades ExamGradingPass   = False
hasExamGradingGrades _                 = True


newtype ExamPartNumber = ExamPartNumber { examPartNumberFragments :: [Either (CI Text) Natural] }
  deriving (Eq, Ord, Generic)
  deriving anyclass (NFData)

_ExamPartNumber :: Iso' ExamPartNumber (CI Text)
_ExamPartNumber = iso pToText pFromText
  where
    pToText = foldMap (either id (CI.mk . tshow)) . examPartNumberFragments
    pFromText = ExamPartNumber . map (\t -> maybe (Left $ CI.mk t) Right $ readMay t) . Text.groupBy ((==) `on` Char.isDigit) . CI.original

_ExamPartNumber' :: Integral n => Prism' ExamPartNumber n
_ExamPartNumber' = prism (ExamPartNumber . fromNum) (first ExamPartNumber . toNum . examPartNumberFragments)
  where
    fromNum (toInteger -> n)
      | n < 0 = [Left "-", Right . fromInteger $ abs n]
      | otherwise = [Right $ fromInteger n]

    toNum fs
      | Just ns <- mapM (preview _Right) fs
      = case ns of
          []  -> Left []
          [n] -> Right $ fromIntegral n
          _   -> Right . fromInteger . read $ concatMap show ns
      | otherwise
      = Left fs

instance Show ExamPartNumber where
  showsPrec p = showsPrec p . CI.original . view _ExamPartNumber
instance Read ExamPartNumber where
  readPrec = review _ExamPartNumber . CI.mk <$> readPrec

instance PersistField ExamPartNumber where
  toPersistValue = toPersistValue . view _ExamPartNumber
  fromPersistValue = fmap (review _ExamPartNumber) . fromPersistValue
instance PersistFieldSql ExamPartNumber where
  sqlType _ = sqlType (Proxy @(CI Text))

instance PathPiece ExamPartNumber where
  toPathPiece = toPathPiece . view _ExamPartNumber
  fromPathPiece = fmap (review _ExamPartNumber) . fromPathPiece

instance ToMarkup ExamPartNumber where
  toMarkup = toMarkup . view _ExamPartNumber
instance ToMessage ExamPartNumber where
  toMessage = toMessage . view _ExamPartNumber

pathPieceCsv ''ExamPartNumber
pathPieceJSON ''ExamPartNumber
pathPieceJSONKey ''ExamPartNumber

instance Enum ExamPartNumber where
  toEnum = review _ExamPartNumber' . toEnum
  fromEnum = maybe (error "Converting non-numeric ExamPartNumber to Int") fromEnum . preview _ExamPartNumber'


data ExamAids
  = ExamAidsPreset { examAidsPreset :: ExamAidsPreset }
  | ExamAidsCustom { examAidsCustom :: StoredMarkup }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)

data ExamAidsPreset
  = ExamOpenBook
  | ExamClosedBook
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 2
  , fieldLabelModifier = camelToPathPiece' 2
  , sumEncoding = TaggedObject "mode" "data"
  } ''ExamAids
derivePersistFieldJSON ''ExamAids

nullaryPathPiece' ''ExamAidsPreset $ nameToPathPiece' 1
pathPieceJSON ''ExamAidsPreset

data ExamOnline
  = ExamOnlinePreset { examOnlinePreset :: ExamOnlinePreset }
  | ExamOnlineCustom { examOnlineCustom :: StoredMarkup }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)

data ExamOnlinePreset
  = ExamOnline
  | ExamOffline
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 2
  , fieldLabelModifier = camelToPathPiece' 2
  , sumEncoding = TaggedObject "mode" "data"
  } ''ExamOnline
derivePersistFieldJSON ''ExamOnline

nullaryPathPiece' ''ExamOnlinePreset $ nameToPathPiece' 1
pathPieceJSON ''ExamOnlinePreset

data ExamSynchronicity
  = ExamSynchronicityPreset { examSynchronicityPreset :: ExamSynchronicityPreset }
  | ExamSynchronicityCustom { examSynchronicityCustom :: StoredMarkup }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)

data ExamSynchronicityPreset
  = ExamSynchronous
  | ExamAsynchronous
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 2
  , fieldLabelModifier = camelToPathPiece' 2
  , sumEncoding = TaggedObject "mode" "data"
  } ''ExamSynchronicity
derivePersistFieldJSON ''ExamSynchronicity

nullaryPathPiece' ''ExamSynchronicityPreset $ nameToPathPiece' 1
pathPieceJSON ''ExamSynchronicityPreset

data ExamRequiredEquipment
  = ExamRequiredEquipmentPreset { examRequiredEquipmentPreset :: ExamRequiredEquipmentPreset }
  | ExamRequiredEquipmentCustom { examRequiredEquipmentCustom :: StoredMarkup }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)

data ExamRequiredEquipmentPreset
  = ExamRequiredEquipmentNone
  | ExamRequiredEquipmentPen
  | ExamRequiredEquipmentPaperPen
  | ExamRequiredEquipmentCalculatorPen
  | ExamRequiredEquipmentCalculatorPaperPen
  | ExamRequiredEquipmentWebcamMicrophoneInternet
  | ExamRequiredEquipmentMicrophoneInternet
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
  deriving anyclass (Universe, Finite, NFData)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 2
  , fieldLabelModifier = camelToPathPiece' 2
  , sumEncoding = TaggedObject "mode" "data"
  } ''ExamRequiredEquipment
derivePersistFieldJSON ''ExamRequiredEquipment

nullaryPathPiece' ''ExamRequiredEquipmentPreset $ nameToPathPiece' 3
pathPieceJSON ''ExamRequiredEquipmentPreset


data ExamMode = ExamMode
  { examAids :: Maybe ExamAids
  , examOnline :: Maybe ExamOnline
  , examSynchronicity :: Maybe ExamSynchronicity
  , examRequiredEquipment :: Maybe ExamRequiredEquipment
  }
  deriving (Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 1
  , sumEncoding = UntaggedValue
  } ''ExamMode
derivePersistFieldJSON ''ExamMode

data ExamModePredicate
  = ExamModePredAids ExamAidsPreset
  | ExamModePredOnline ExamOnlinePreset
  | ExamModePredSynchronicity ExamSynchronicityPreset
  | ExamModePredRequiredEquipment ExamRequiredEquipmentPreset
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (NFData)
deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 3
  , sumEncoding = TaggedObject "setting" "preset"
  } ''ExamModePredicate
derivePathPiece ''ExamModePredicate (camelToPathPiece' 3) "--"
deriveFinite ''ExamModePredicate

newtype ExamModeDNF = ExamModeDNF { examModeDNF :: PredDNF ExamModePredicate }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving newtype (ToJSON, FromJSON, PathPiece)
  deriving anyclass (NFData)

derivePersistFieldJSON ''ExamModeDNF


data ExamCloseMode
  = ExamCloseSeparate
  | ExamCloseOnFinished { examCloseOnFinishedHidden :: Bool }
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (Binary, NFData)
deriveFinite ''ExamCloseMode
finitePathPiece ''ExamCloseMode ["separate", "on-finished", "on-finished-hidden"]
derivePersistFieldPathPiece ''ExamCloseMode
pathPieceJSON ''ExamCloseMode
pathPieceJSONKey ''ExamCloseMode
pathPieceHttpApiData ''ExamCloseMode

makeLenses_ ''ExamCloseMode
makePrisms ''ExamCloseMode

_ExamCloseOnFinished', _ExamCloseOnFinishedHidden :: Prism' ExamCloseMode ()
_ExamCloseOnFinished' = _ExamCloseOnFinished . only False
_ExamCloseOnFinishedHidden = _ExamCloseOnFinished . only True
