{-# LANGUAGE UndecidableInstances #-}

module Model.Migration.Types
  ( module Model.Migration.Types
  ) where

import ClassyPrelude.Yesod
import Data.Aeson
import Data.Aeson.TH (deriveJSON, mkParseJSON)

import Utils.PathPiece

import qualified Model as Current
import qualified Model.Types.TH.JSON as Current

import Data.Universe
import Data.Universe.TH

import qualified Data.Set as Set

import Model.Migration.Version as Model.Migration.Types


data SheetType
  = Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben
  | Bonus  { maxPoints :: Current.Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
  | Pass   { maxPoints, passingPoints :: Current.Points }
  | NotGraded
  deriving (Show, Read, Eq)

sheetType :: SheetType -> Current.SheetType a
sheetType Bonus {..}  = Current.Bonus  Current.Points {..}
sheetType Normal {..} = Current.Normal Current.Points {..}
sheetType Pass {..}   = Current.Normal Current.PassPoints {..}
sheetType NotGraded   = Current.NotGraded


data UploadMode = NoUpload | Upload { unpackZips :: Bool }
  deriving (Show, Read, Eq, Ord, Generic)

deriveJSON defaultOptions ''UploadMode
Current.derivePersistFieldJSON ''UploadMode

deriveFinite ''UploadMode
finitePathPiece ''UploadMode ["no-upload", "no-unpack", "unpack"]

data SheetSubmissionMode = NoSubmissions
                         | CorrectorSubmissions
                         | UserSubmissions
  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece
  } ''SheetSubmissionMode
derivePersistField "SheetSubmissionMode"

instance Universe SheetSubmissionMode
instance Finite SheetSubmissionMode

nullaryPathPiece ''SheetSubmissionMode camelToPathPiece

deriveJSON defaultOptions ''SheetType
Current.derivePersistFieldJSON ''SheetType



data Transaction
  = TransactionTermEdit
    { transactionTerm   :: Current.TermIdentifier
    }
  | TransactionExamRegister
    { transactionTerm   :: Current.TermIdentifier
    , transactionSchool :: Current.SchoolShorthand
    , transactionCourse :: Current.CourseShorthand
    , transactionExam   :: Current.ExamName
    , transactionUser   :: Current.UserIdent
    }
  | TransactionExamDeregister
    { transactionTerm   :: Current.TermIdentifier
    , transactionSchool :: Current.SchoolShorthand
    , transactionCourse :: Current.CourseShorthand
    , transactionExam   :: Current.ExamName
    , transactionUser   :: Current.UserIdent
    }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , fieldLabelModifier = camelToPathPiece' 1
  , tagSingleConstructors = True
  , sumEncoding = TaggedObject "transaction" "data"
  } ''Transaction

Current.derivePersistFieldJSON ''Transaction



data PredLiteral a = PLVariable { plVar :: a } | PLNegated { plVar :: a }
  deriving (Eq, Ord)
deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  , sumEncoding = TaggedObject "val" "var"
  } ''PredLiteral
  
newtype PredDNF a = PredDNF { dnfTerms :: Set (NonNull (Set (PredLiteral a))) }

$(return [])

instance ToJSON (PredDNF a) where
  toJSON = error "toJSON @(Legacy.PredDNF _): not implemented"
instance (Ord a, FromJSON a) => FromJSON (PredDNF a) where
  parseJSON = $(mkParseJSON defaultOptions{ tagSingleConstructors = True, sumEncoding = ObjectWithSingleField } ''PredDNF)

newtype ExamModeDNF = ExamModeDNF (PredDNF Current.ExamModePredicate)
  deriving newtype (ToJSON, FromJSON)

Current.derivePersistFieldJSON ''ExamModeDNF

examModeDNF :: ExamModeDNF -> Current.ExamModeDNF
examModeDNF (ExamModeDNF PredDNF{..}) = Current.ExamModeDNF . Current.PredDNF $ Set.map (impureNonNull . Set.map toCurrentPredLiteral . toNullable) dnfTerms
  where toCurrentPredLiteral PLVariable{..} = Current.PLVariable plVar
        toCurrentPredLiteral PLNegated{..} = Current.PLNegated plVar
