module Handler.Utils.Table.Cells where

import Import hiding (link)

import Data.CaseInsensitive (CI)
-- import qualified Data.CaseInsensitive as CI

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

import Text.Blaze (ToMarkup(..))

import Handler.Utils.Table.Pagination
import Handler.Utils.DateTime
import Handler.Utils.Widgets

import Utils.Occurrences

import qualified Data.Set as Set


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

----------------
-- Some basic cells are defined in Handler.Utils.Table.Pagination
-- such as: i18nCell, cellTooltip, anchorCell for links, etc.

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

-- | Display a breakable space
spacerCell :: IsDBTable m a => DBCell m a
spacerCell = cell [whamlet| |]

tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
tellCell = flip mappend . writerCell . tell

cellTell :: IsDBTable m a => DBCell m a -> a -> DBCell m a
cellTell = flip tellCell

indicatorCell :: IsDBTable m Any => DBCell m Any -- For dbTables that return a Bool to indicate content
indicatorCell = writerCell . tell $ Any True

writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
writerCell act = mempty & cellContents %~ (<* act)

maybeCell :: IsDBTable m a => Maybe a -> (a -> DBCell m a) -> DBCell m a
maybeCell = flip foldMap

htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
htmlCell = cell . toWidget . toMarkup

pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
pathPieceCell = cell . toWidget . toPathPiece

-- | execute a DB action that return a widget for the cell contents
sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
sqlCell act = mempty & cellContents .~ lift act

-- | Highlight table cells with warning: Is not yet implemented in frontend.
markCell :: IsDBTable m a => MessageStatus -> (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a)
markCell status condition normal x
   | condition x = normal x & addCellClass (statusToUrgencyClass status)
   | otherwise   = normal x

ifCell :: (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a) -> (t -> DBCell m a)
ifCell decision cTrue cFalse x
  | decision x = cTrue  x
  | otherwise  = cFalse x

linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
linkEmptyCell = anchorCell

msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
msgCell = textCell . toMessage

-- Recall: for line numbers, use dbRow

---------------------
-- Icon cells

iconCell :: IsDBTable m a => Icon -> DBCell m a
iconCell = cell . toWidget . icon

addIconFixedWidth :: IsDBTable m a => DBCell m a -> DBCell m a
addIconFixedWidth = addCellClass ("icon-fixed-width" :: Text)

iconSpacerCell :: IsDBTable m a => DBCell m a
iconSpacerCell = mempty & addIconFixedWidth

-- | Maybe display a tickmark/checkmark icon
tickmarkCell :: IsDBTable m a => Bool -> DBCell m a
tickmarkCell = cell . toWidget . hasTickmark

-- | Maybe display an icon for tainted rows
isBadCell :: IsDBTable m a => Bool -> DBCell m a
isBadCell = cell . toWidget . isBad

-- | Maybe display a exclamation icon
isNewCell :: IsDBTable m a => Bool -> DBCell m a
isNewCell = cell . toWidget . isNew

-- | Maybe display comment icon linking a given URL or show nothing at all
commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
commentCell Nothing     = mempty
commentCell (Just link) = anchorCell link $ hasComment True

-- | whether something is visible or hidden
isVisibleCell :: IsDBTable m a => Bool -> DBCell m a
isVisibleCell True  =  cell . toWidget $ isVisible True
isVisibleCell False = (cell . toWidget $ isVisible False) & addUrgencyClass
  where
    addUrgencyClass = addCellClass $ statusToUrgencyClass Warning

-- | for simple file downloads
fileCell :: IsDBTable m a => Route UniWorX -> DBCell m a
fileCell route = anchorCell route iconFileDownload

-- | for zip-archive downloads
zipCell :: IsDBTable m a => Route UniWorX -> DBCell m a
zipCell route = anchorCell route iconFileZip

-- | for csv downloads
csvCell :: IsDBTable m a => Route UniWorX -> DBCell m a
csvCell route = anchorCell route iconFileCSV

-- | Display an icon that opens a modal upon clicking
modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a
modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget content)

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

dateCell :: IsDBTable m a => UTCTime -> DBCell m a
dateCell t = cell $ formatTime SelFormatDate t >>= toWidget

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

-- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning
--
--   Cannot use `Handler.Utils.visibleUTCTime`, since setting the UrgencyClass must be done outside the monad, hence the watershed argument.
dateTimeCellVisible :: IsDBTable m a => UTCTime -> UTCTime -> DBCell m a
dateTimeCellVisible watershed t
    | watershed < t = cell $(widgetFile "widgets/date-time/yet-invisible") & addUrgencyClass
    | otherwise     = cell timeStampWgt
  where
    timeStampWgt    = formatTimeW SelFormatDateTime t
    addUrgencyClass = addCellClass $ statusToUrgencyClass Warning

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

emailCell :: IsDBTable m a => CI Text -> DBCell m a
emailCell email = cell $(widgetFile "widgets/link-email")
  where linkText= toWgt email

cellHasUser :: (IsDBTable m c, HasUser a) => a -> DBCell m c
cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)

cellHasUserLink :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c
-- cellHasUserLink toLink user =
--   let uid   = user ^. hasEntityUser . _entityKey
--       nWdgt = nameWidget (user ^. hasEntityUser . _entityVal . _userDisplayName) (user ^. hasEntityUser .  _entityVal . _userSurname)
--   in  anchorCellM (toLink <$> encrypt uid) nWdgt
cellHasUserLink toLink user =
  let userEntity = user ^. hasEntityUser
      uid   = userEntity ^. _entityKey
      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
  in  anchorCellM (toLink <$> encrypt uid) nWdgt

cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer

cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
cellHasEMail = emailCell . view _userEmail


cellHasSemester :: (IsDBTable m c, HasStudyFeatures a) => a -> DBCell m c
cellHasSemester = numCell . view _studyFeaturesSemester


cellHasField :: (IsDBTable m c, HasStudyTerms a) => a -> DBCell m c
cellHasField x = maybe (numCell $ x ^. _studyTermsKey) textCell $ x ^. _studyTermsName <|> x ^. _studyTermsShorthand


cellHasDegreeShort :: (IsDBTable m c, HasStudyDegree a) => a -> DBCell m c
cellHasDegreeShort x = maybe (numCell $ x ^. _studyDegreeKey) textCell $ x ^. _studyDegreeShorthand <|> x ^. _studyDegreeName



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

numCell :: (IsDBTable m a, ToMessage b) => b -> DBCell m a
numCell = textCell . toMessage

propCell :: (IsDBTable m a, Real b, ToMessage b) => b -> b -> DBCell m a
propCell curr max' = i18nCell $ MsgProportion (toMessage curr) (toMessage max') (toRational curr / toRational max')

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 = toWgt tid

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

schoolCell :: IsDBTable m a => TermId -> SchoolId -> DBCell m a
schoolCell tid ssh  = anchorCell link name
  where
    link = TermSchoolCourseListR tid ssh
    name = toWgt ssh

schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
schoolCellCL (tid,ssh,_) = schoolCell 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 = toWgt 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|
              $newline never
              <div>
                ^{modal "Beschreibung" (Right $ toWidget descr)}
              |]

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 $ toWgt 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      = toWgt
  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

occurrencesCell :: IsDBTable m a => Occurrences -> DBCell m a
occurrencesCell (normalizeOccurrences -> Occurrences{..}) = cell $ do
  let occurrencesScheduled' = flip map (Set.toList occurrencesScheduled) $ \case
        ScheduleWeekly{..} -> do
          scheduleStart' <- formatTime SelFormatTime scheduleStart
          scheduleEnd' <- formatTime SelFormatTime scheduleEnd
          $(widgetFile "widgets/occurrence/cell/weekly")
      occurrencesExceptions' = flip map (Set.toList occurrencesExceptions) $ \case
        ExceptOccur{..} -> do
          exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
          exceptEnd'   <- formatTime SelFormatTime     exceptStart
          $(widgetFile "widgets/occurrence/cell/except-occur")
        ExceptNoOccur{..} -> do
          exceptTime' <- formatTime SelFormatDateTime exceptTime
          $(widgetFile "widgets/occurrence/cell/except-no-occur")
  $(widgetFile "widgets/occurrence/cell")