{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleContexts #-}

module Handler.Utils.Table.Cells where

import Import

import Data.Monoid (Any(..))
import Control.Monad.Writer.Class (MonadWriter(..))

import Utils.Lens
import Handler.Utils


type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles !

--------------------
-- Special cells

indicatorCell :: IsDBTable m Any => DBCell m Any -- For dbTables that return a Bool to indicate content
indicatorCell = mempty & cellContents %~ (tell (Any True) *>)

-- Datatype cells
timeCell :: IsDBTable m a => UTCTime -> DBCell m a
timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget

userCell :: IsDBTable m a => Text -> Text -> DBCell m a
userCell displayName surname = cell $ nameWidget displayName surname

-- Just for documentation purposes; inline this code instead:
maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a
maybeTimeCell = maybe mempty timeCell

numCell :: (IsDBTable m a, Num b, DisplayAble b) => b -> DBCell m a
numCell = textCell . display

int64Cell :: (IsDBTable m a) => Int64-> DBCell m a
int64Cell = numCell

termCell :: IsDBTable m a => TermId -> DBCell m a
termCell tid = anchorCell link name
  where
    link = TermCourseListR tid
    name = text2widget $ display tid

termCellCL :: IsDBTable m a => CourseLink -> DBCell m a
termCellCL (tid,_,_) = termCell tid

schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a
schoolCell (Just tid) ssh  = anchorCell link name
  where
    link = TermSchoolCourseListR tid ssh
    name = text2widget $ display ssh
schoolCell Nothing ssh  = anchorCell link name
  where
    link = SchoolShowR ssh
    name = text2widget $ display ssh

schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
schoolCellCL (tid,ssh,_) = schoolCell (Just tid) ssh

courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a
courseCellCL (tid,ssh,csh) = anchorCell link name
  where
    link = CourseR tid ssh csh CShowR
    name = citext2widget csh

courseCell :: IsDBTable m a => Course -> DBCell m a
courseCell (Course {..}) = anchorCell link name `mappend` desc
  where
    link = CourseR courseTerm courseSchool courseShorthand CShowR
    name = citext2widget courseName
    desc = case courseDescription of
            Nothing      -> mempty
            (Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic "Beschreibung" descr False} |]

sheetCell :: IsDBTable m a => CourseLink -> SheetName -> DBCell m a
sheetCell crse shn =
  let tid = crse ^. _1
      ssh = crse ^. _2
      csh = crse ^. _3
      link= CSheetR tid ssh csh shn SShowR
  in anchorCell link $ display2widget shn

submissionCell :: IsDBTable m a => CourseLink -> SheetName -> SubmissionId -> DBCell m a
submissionCell crse shn sid =
  let tid = crse ^. _1
      ssh = crse ^. _2
      csh = crse ^. _3
      mkCid = encrypt sid
      mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
      mkText  cid = display2widget cid
  in anchorCellM' mkCid mkRoute mkText

correctorStateCell :: IsDBTable m a => SheetCorrector -> DBCell m a
correctorStateCell sc =
  i18nCell $ sheetCorrectorState sc

correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
correctorLoadCell sc =
  i18nCell $ sheetCorrectorLoad sc