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

module Handler.Utils.Table.Convenience where

import Import

import Utils.Lens
import Handler.Utils
-- import Handler.Utils.Table.Pagination

import qualified Database.Esqueleto as E (Value(..))

-- newtype CourseLink = CourseLink (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
type CourseLink = (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
-- TODO: can we get rid of this type through lenses?
type CourseLink' = (E.Value TermId, E.Value SchoolId, E.Value CourseId, E.Value CourseShorthand) -- cannot be in Types due to CourseId



-- Special cells

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

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

termCell :: IsDBTable m a => TermId -> DBCell m a
termCell tid = anchorCell link name
  where
    link = TermCourseListR tid
    name = text2widget $ display 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

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

courseLinkCell' :: IsDBTable m a => CourseLink' -> DBCell m a
courseLinkCell' (E.Value tid, E.Value ssh,_cid,E.Value 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 descr} |]

sheetCell :: IsDBTable m a => (CourseLink', E.Value SheetName) -> DBCell m a
sheetCell (crse, E.Value shn) =
  let tid = crse ^. _1 . _unValue
      ssh = crse ^. _2 . _unValue
      csh = crse ^. _4 . _unValue
      link= CSheetR tid ssh csh shn SShowR
  in anchorCell link $ display2widget shn

submissionCell :: IsDBTable m a => (CourseLink', E.Value SheetName, Entity Submission) -> DBCell m a
submissionCell (crse, E.Value shn, submission) =
  let tid = crse ^. _1 . _unValue
      ssh = crse ^. _2 . _unValue
      csh = crse ^. _4 . _unValue
      sid = entityKey submission
      mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice -- FIXED here, but not everywhere!
      mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
      mkText  cid = display2widget cid
  in anchorCellM' mkCid mkRoute mkText


-- Generic Columns
colCourseDescr :: IsDBTable m a => Getting Course s Course -> Colonnade Sortable s (DBCell m a)
colCourseDescr getter =
  sortable (Just "course") (i18nCell MsgCourse) $ do
    course <- view getter
    return $ courseCell course

colsCourseDescr :: IsDBTable m a => Getting Course s Course -> Colonnade Sortable s (DBCell m a)
colsCourseDescr getter = mconcat
  [ sortable (Just "term") (i18nCell MsgTerm) $ do
      course <- view getter
      return $ termCell $ courseTerm course
  , sortable (Just "school") (i18nCell MsgCourseSchool) $ do
      course <- view getter
      return $ schoolCell (Just $ courseTerm course) (courseSchool course)
  , sortable (Just "course") (i18nCell MsgCourse) $ do
      course <- view getter
      return $ courseCell course
  ]

colsCourseLink :: (IsDBTable m a) => Getting CourseLink s CourseLink -> Colonnade Sortable s (DBCell m a)
colsCourseLink getter = mconcat
  [ sortable (Just "term") (i18nCell MsgTerm) $ do
      crs <- view getter
      return $ termCell $ crs ^. _1
  , sortable (Just "school") (i18nCell MsgCourseSchool) $ do
      crs <- view getter
      return $ schoolCell (Just $ crs ^. _1) (crs ^. _2)
  , sortable (Just "course") (i18nCell MsgCourse) $ do
      crs <- view getter
      return $ courseLinkCell crs
  ]

colsCourseLink' :: (IsDBTable m a) => Getting CourseLink' s CourseLink' -> Colonnade Sortable s (DBCell m a)
colsCourseLink' getter = mconcat
  [ sortable (Just "term") (i18nCell MsgTerm) $ do
      crs <- view getter
      return $ termCell $ crs ^. _1 . _unValue
  , sortable (Just "school") (i18nCell MsgCourseSchool) $ do
      crs <- view getter
      return $ schoolCell (Just $ crs ^. _1 . _unValue) (crs ^. _2  . _unValue)
  , sortable (Just "course") (i18nCell MsgCourse) $ do
      crs <- view getter
      return $ courseLinkCell' crs
  ]