module Handler.Utils.Sheet where

import Import
import Handler.Utils.Delete

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E


-- | Map sheet file types to their visibily dates of a given sheet, for convenience
sheetFileTypeDates :: Sheet -> SheetFileType -> Maybe UTCTime
sheetFileTypeDates Sheet{..} = \case
  SheetExercise -> Just sheetActiveFrom
  SheetHint     -> sheetHintFrom
  SheetSolution -> sheetSolutionFrom
  SheetMarking  -> Nothing


fetchSheetAux ::  ( BaseBackend backend ~ SqlBackend
                  , E.SqlSelect b a
                  , Typeable a, MonadHandler m, IsPersistBackend backend
                  , PersistQueryRead backend, PersistUniqueRead backend
                  )
  =>  (E.SqlExpr (Entity Sheet) -> E.SqlExpr (Entity Course) -> b)
      -> TermId -> SchoolId -> CourseShorthand -> SheetName -> ReaderT backend m a
fetchSheetAux prj tid ssh csh shn =
    let cachId = encodeUtf8 $ tshow (tid, ssh, csh, shn)
    in  cachedBy cachId $ do
    -- Mit Yesod:
    -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    -- getBy404 $ CourseSheet cid shn
    -- Mit Esqueleto:
        sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
            E.on     $ course E.^. CourseId E.==. sheet E.^. SheetCourse
            E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                E.&&.  course E.^. CourseSchool    E.==. E.val ssh
                E.&&.  course E.^. CourseShorthand E.==. E.val csh
                E.&&.  sheet  E.^. SheetName       E.==. E.val shn
            return $ prj sheet course
        case sheetList of
          [sheet] -> return sheet
          _other  -> notFound

fetchSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet)
fetchSheet = fetchSheetAux const

fetchSheetCourse :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet, Entity Course)
fetchSheetCourse = fetchSheetAux (,)

fetchSheetId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet)
fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (\sheet _ -> sheet E.^. SheetId) tid ssh cid shn

fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux (\sheet course -> (sheet E.^. SheetId, course E.^. CourseId)) tid ssh cid shn


sheetDeleteRoute :: Set SheetId -> DeleteRoute Sheet
sheetDeleteRoute drRecords = DeleteRoute
  { drRecords
  , drGetInfo = \(sheet `E.InnerJoin` course `E.InnerJoin` school) -> do
      E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
      E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
      let submissions = E.sub_select . E.from $ \submission -> do
            E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
            return E.countRows
      E.orderBy [E.asc $ sheet E.^. SheetName]
      return (submissions, sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
  , drUnjoin = \(sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet
  , drRenderRecord = \(E.Value submissions, E.Value shn', _, E.Value cName, _, E.Value sName, E.Value tid') ->
      return [whamlet|
        $newline never
        #{shn'} (_{SomeMessage $ ShortTermIdentifier (unTermKey tid')}, #{sName}, #{cName})
        $if submissions /= 0
          &nbsp;<i>_{SomeMessage $ MsgSheetDelHasSubmissions submissions}
      |]
  , drRecordConfirmString = \(E.Value submissions, E.Value shn', E.Value csh', _, E.Value ssh', _, E.Value tid') ->
      return $ [st|#{termToText (unTermKey tid')}/#{ssh'}/#{csh'}/#{shn'}|] <> bool mempty [st| + #{tshow submissions} Subs|] (submissions /= 0)
  , drCaption = SomeMessage MsgSheetDeleteQuestion
  , drSuccessMessage = SomeMessage MsgSheetDeleted
  , drAbort = error "drAbort undefined"
  , drSuccess = error "drSuccess undefined"
  }
