fradrive/src/Model.hs

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

{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances, DeriveAnyClass #-}

module Model
  ( module Model
  , module Model.Types
  , module Cron.Types
  ) where

import Import.NoModel
import Database.Persist.Quasi
import Database.Persist.TH.Directory
-- import Data.Time
-- import Data.ByteString
import Model.Types hiding (_maxPoints, _passingPoints)
import Cron.Types

import Data.CaseInsensitive (original)
import Data.CaseInsensitive.Instances ()

import Settings.Cluster (ClusterSettingsKey)

import Text.Blaze (ToMarkup(..))

import Database.Persist.Sql (BackendKey(..))

import qualified Database.Esqueleto.Legacy as E


type SqlBackendKey = BackendKey SqlBackend


-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings{ mpsDeriveInstances = [''NFData] }, mkMigrate "migrateUniWorX", mkEntityDefList "currentModel"]
    $(persistDirectoryWith lowerCaseSettings "models")


submissionRatingDone :: Submission -> Bool
submissionRatingDone Submission{..} = isJust submissionRatingTime

sqlSubmissionRatingDone :: E.SqlExpr (Entity Submission) -> E.SqlExpr (E.Value Bool)
sqlSubmissionRatingDone submission = E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime


deriving newtype instance ToJSONKey UserId
deriving newtype instance FromJSONKey UserId
deriving newtype instance ToJSONKey ExamOccurrenceId
deriving newtype instance FromJSONKey ExamOccurrenceId

deriving newtype instance ToSample UserId
deriving newtype instance ToSample ExternalApiId

-- required Show instances for use of getByJust 
deriving instance Show (Unique ExamPart)
deriving instance Show (Unique QualificationUser)
deriving instance Show (Unique LmsUser)

-- ToMarkup and ToMessage instances for displaying selected database primary keys

instance ToMarkup (Key School) where
  toMarkup = toMarkup . unSchoolKey

instance ToMessage (Key School) where
  toMessage = original . unSchoolKey

instance ToMarkup (Key Term) where
  toMarkup = toMarkup . termToText . unTermKey

instance ToMessage (Key Term) where
  toMessage = termToText . unTermKey


instance HasFileReference SheetFile where
  data FileReferenceResidual SheetFile = SheetFileResidual
    { sheetFileResidualSheet :: SheetId
    , sheetFileResidualType :: SheetFileType
    } deriving (Eq, Ord, Read, Show, Generic)

  _FileReference
    = iso (\SheetFile{..} -> ( FileReference
                               { fileReferenceTitle    = sheetFileTitle
                               , fileReferenceContent  = sheetFileContent
                               , fileReferenceModified = sheetFileModified
                               }
                             , SheetFileResidual
                               { sheetFileResidualSheet = sheetFileSheet
                               , sheetFileResidualType  = sheetFileType
                               }
                             )
          )
          (\( FileReference{..}
            , SheetFileResidual{..}
            ) -> SheetFile
                 { sheetFileSheet      = sheetFileResidualSheet
                 , sheetFileType       = sheetFileResidualType
                 , sheetFileTitle      = fileReferenceTitle
                 , sheetFileContent    = fileReferenceContent
                 , sheetFileModified   = fileReferenceModified
                 }
          )

instance IsFileReference SheetFile where
  fileReferenceTitleField    = SheetFileTitle
  fileReferenceContentField  = SheetFileContent
  fileReferenceModifiedField = SheetFileModified

instance HasFileReference PersonalisedSheetFile where
  data FileReferenceResidual PersonalisedSheetFile = PersonalisedSheetFileResidual
    { personalisedSheetFileResidualSheet :: SheetId
    , personalisedSheetFileResidualUser :: UserId
    , personalisedSheetFileResidualType :: SheetFileType
    } deriving (Eq, Ord, Read, Show, Generic)

  _FileReference
    = iso (\PersonalisedSheetFile{..} -> ( FileReference
                               { fileReferenceTitle    = personalisedSheetFileTitle
                               , fileReferenceContent  = personalisedSheetFileContent
                               , fileReferenceModified = personalisedSheetFileModified
                               }
                             , PersonalisedSheetFileResidual
                               { personalisedSheetFileResidualSheet = personalisedSheetFileSheet
                               , personalisedSheetFileResidualUser  = personalisedSheetFileUser
                               , personalisedSheetFileResidualType  = personalisedSheetFileType
                               }
                             )
          )
          (\( FileReference{..}
            , PersonalisedSheetFileResidual{..}
            ) -> PersonalisedSheetFile
                 { personalisedSheetFileSheet      = personalisedSheetFileResidualSheet
                 , personalisedSheetFileUser       = personalisedSheetFileResidualUser
                 , personalisedSheetFileType       = personalisedSheetFileResidualType
                 , personalisedSheetFileTitle      = fileReferenceTitle
                 , personalisedSheetFileContent    = fileReferenceContent
                 , personalisedSheetFileModified   = fileReferenceModified
                 }
          )

instance IsFileReference PersonalisedSheetFile where
  fileReferenceTitleField    = PersonalisedSheetFileTitle
  fileReferenceContentField  = PersonalisedSheetFileContent
  fileReferenceModifiedField = PersonalisedSheetFileModified
 
instance HasFileReference SubmissionFile where
  data FileReferenceResidual SubmissionFile = SubmissionFileResidual
    { submissionFileResidualSubmission :: SubmissionId
    , submissionFileResidualIsUpdate
    , submissionFileResidualIsDeletion :: Bool
    } deriving (Eq, Ord, Read, Show, Generic)

  _FileReference
    = iso (\SubmissionFile{..} -> ( FileReference
                                    { fileReferenceTitle    = submissionFileTitle
                                    , fileReferenceContent  = submissionFileContent
                                    , fileReferenceModified = submissionFileModified
                                    }
                                  , SubmissionFileResidual
                                    { submissionFileResidualSubmission = submissionFileSubmission
                                    , submissionFileResidualIsUpdate   = submissionFileIsUpdate
                                    , submissionFileResidualIsDeletion = submissionFileIsDeletion
                                    }
                                  )
          )
          (\( FileReference{..}
            , SubmissionFileResidual{..}
            ) -> SubmissionFile
                 { submissionFileSubmission = submissionFileResidualSubmission
                 , submissionFileIsUpdate   = submissionFileResidualIsUpdate
                 , submissionFileIsDeletion = submissionFileResidualIsDeletion
                 , submissionFileTitle      = fileReferenceTitle
                 , submissionFileContent    = fileReferenceContent
                 , submissionFileModified   = fileReferenceModified
                 }
          )

instance IsFileReference SubmissionFile where
  fileReferenceTitleField = SubmissionFileTitle
  fileReferenceContentField = SubmissionFileContent
  fileReferenceModifiedField = SubmissionFileModified

instance HasFileReference CourseNewsFile where
  newtype FileReferenceResidual CourseNewsFile
    = CourseNewsFileResidual { courseNewsFileResidualNews :: CourseNewsId }
    deriving (Eq, Ord, Read, Show, Generic)

  _FileReference
    = iso (\CourseNewsFile{..} -> ( FileReference
                                    { fileReferenceTitle    = courseNewsFileTitle
                                    , fileReferenceContent  = courseNewsFileContent
                                    , fileReferenceModified = courseNewsFileModified
                                    }
                                  , CourseNewsFileResidual courseNewsFileNews
                                  )
          )
          (\( FileReference{..}
            , CourseNewsFileResidual courseNewsFileNews
            ) -> CourseNewsFile
                 { courseNewsFileNews
                 , courseNewsFileTitle    = fileReferenceTitle
                 , courseNewsFileContent  = fileReferenceContent
                 , courseNewsFileModified = fileReferenceModified
                 }
          )

instance IsFileReference CourseNewsFile where
  fileReferenceTitleField = CourseNewsFileTitle
  fileReferenceContentField = CourseNewsFileContent
  fileReferenceModifiedField = CourseNewsFileModified

instance HasFileReference MaterialFile where
  newtype FileReferenceResidual MaterialFile
    = MaterialFileResidual { materialFileResidualMaterial :: MaterialId }
    deriving (Eq, Ord, Read, Show, Generic)

  _FileReference
    = iso (\MaterialFile{..} -> ( FileReference
                               { fileReferenceTitle    = materialFileTitle
                               , fileReferenceContent  = materialFileContent
                               , fileReferenceModified = materialFileModified
                               }
                             , MaterialFileResidual
                               { materialFileResidualMaterial = materialFileMaterial
                               }
                             )
          )
          (\( FileReference{..}
            , MaterialFileResidual{..}
            ) -> MaterialFile
                 { materialFileMaterial = materialFileResidualMaterial
                 , materialFileTitle    = fileReferenceTitle
                 , materialFileContent  = fileReferenceContent
                 , materialFileModified = fileReferenceModified
                 }
          )

instance IsFileReference MaterialFile where
  fileReferenceTitleField = MaterialFileTitle
  fileReferenceContentField = MaterialFileContent
  fileReferenceModifiedField = MaterialFileModified

deriveJSON  defaultOptions
  { tagSingleConstructors = False
  , fieldLabelModifier     = camelToPathPiece' 2
  , omitNothingFields = True  
  } ''QualificationUserBlock