{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Exam.CorrectorInvite
  ( InvitableJunction(..)
  , InvitationDBData(..)
  , InvitationTokenData(..)
  , examCorrectorInvitationConfig
  , getECInviteR, postECInviteR
  ) where

import Import
import Handler.Utils.Invitations
import Handler.Utils.Exam

import Text.Hamlet (ihamlet)

import Data.Aeson hiding (Result(..))

  
instance IsInvitableJunction ExamCorrector where
  type InvitationFor ExamCorrector = Exam
  data InvitableJunction ExamCorrector = JunctionExamCorrector
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
  data InvitationDBData ExamCorrector = InvDBDataExamCorrector
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
  data InvitationTokenData ExamCorrector = InvTokenDataExamCorrector
    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _InvitableJunction = iso
    (\ExamCorrector{..} -> (examCorrectorUser, examCorrectorExam, JunctionExamCorrector))
    (\(examCorrectorUser, examCorrectorExam, JunctionExamCorrector) -> ExamCorrector{..})

instance ToJSON (InvitableJunction ExamCorrector) where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
instance FromJSON (InvitableJunction ExamCorrector) where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }

instance ToJSON (InvitationDBData ExamCorrector) where
  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
instance FromJSON (InvitationDBData ExamCorrector) where
  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }

instance ToJSON (InvitationTokenData ExamCorrector) where
  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 4 }
instance FromJSON (InvitationTokenData ExamCorrector) where
  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 4 }

examCorrectorInvitationConfig :: InvitationConfig ExamCorrector
examCorrectorInvitationConfig = InvitationConfig{..}
  where
    invitationRoute (Entity _ Exam{..}) _ = do
      Course{..} <- get404 examCourse
      return $ CExamR courseTerm courseSchool courseShorthand examName ECInviteR
    invitationResolveFor _ = do
      cRoute <- getCurrentRoute
      case cRoute of
        Just (CExamR tid csh ssh examn ECInviteR) ->
          fetchExamId tid csh ssh examn
        _other ->
          error "examCorrectorInvitationConfig called from unsupported route"
    invitationSubject (Entity _ Exam{..}) _ = do
      Course{..} <- get404 examCourse
      return . SomeMessage $ MsgMailSubjectExamCorrectorInvitation courseTerm courseSchool courseShorthand examName
    invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandler requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
    invitationRestriction _ _ = return Authorized
    invitationForm _ _ _ = pure (JunctionExamCorrector, ())
    invitationInsertHook _ _ _ _ = id
    invitationSuccessMsg (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInvitationAccepted examName
    invitationUltDest (Entity _ Exam{..}) _ = do
      Course{..} <- get404 examCourse
      return . SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName EShowR

getECInviteR, postECInviteR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getECInviteR = postECInviteR
postECInviteR = invitationR examCorrectorInvitationConfig