module Handler.Utils.Table.Cells where

import Import

import qualified Control.Monad.Trans.RWS.Lazy

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

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.

----------------
-- Cell transformation

-- | Add cell attributes
addCellAttrs :: [(Text, Text)]
  -> DBCell (Control.Monad.Trans.RWS.Lazy.RWST
                              (Maybe (Env, FileEnv), UniWorX, [Lang])
                              Enctype
                              Ints
                              (HandlerT UniWorX IO))
                           x
  -> DBCell (Control.Monad.Trans.RWS.Lazy.RWST
                              (Maybe (Env, FileEnv), UniWorX, [Lang])
                              Enctype
                              Ints
                              (HandlerT UniWorX IO))
                           x
addCellAttrs newAttrs fcell = fcell { formCellAttrs = newAttrs <> formCellAttrs fcell } -- Isn't there already a lens for that?


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

-- | Display a breakable space
spacerCell :: (IsDBTable m a) => DBCell m a
spacerCell = cell [whamlet|&emsp;|]

tellCell :: (Monoid a, IsDBTable m a) => a -> DBCell m a -> DBCell m a
tellCell = flip mappend . writerCell . tell

cellTell :: (Monoid a, 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 & over cellAttrs (insertAttr "class" $ statusToUrgencyClass status)
   | otherwise   = normal x

ifCell :: (IsDBTable m a) => (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 = over cellAttrs $ insertClass "icon-fixed-width"

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 = over cellAttrs $ insertClass $ 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 = over cellAttrs $ insertClass $ 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, Num b, 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")