module Handler.Utils.Table.Cells where

import Import hiding (link)

import Text.Blaze (ToMarkup(..))

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


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|&emsp;|]

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)

-- for documentation purposes 
cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
cellMaybe = foldMap

maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
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

guardAuthCell :: (IsDBTable m a, MonadAP m, MonadThrow m)
              => m (Route UniWorX, Bool) -- ^ @(route, isWrite)@
              -> DBCell m a -> DBCell m a
guardAuthCell mkParams = over cellContents $ \act -> do
  (route, isWrite) <- lift mkParams
  ifM (fmap (is _Authorized) . lift $ evalAccess route isWrite) act (return mempty)

-- Recall: for line numbers, use dbRow

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

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

ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a
ifIconCell True  = iconCell
ifIconCell False = const iconSpacerCell

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, [(Text, Text)]) -> DBCell m a
fileCell route = anchorCell route iconFileDownload

-- | for zip-archive downloads
zipCell :: IsDBTable m a => (Route UniWorX, [(Text, Text)]) -> 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)

markupCellLargeModal :: IsDBTable m a => StoredMarkup -> DBCell m a
markupCellLargeModal mup
  | markupIsSmallish mup = cell $ toWidget mup
  | otherwise = modalCell mup  

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

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

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

dayCell :: IsDBTable m a => Day -> DBCell m a
dayCell utctDay = cell $ formatTime SelFormatDate UTCTime{..} >>= toWidget
  where utctDayTime = 0

-- | 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

{- Recall:
userCell' :: IsDBTable m a => User -> DBCell m a
userCell' = cellHasUser
-}

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'
  | max' /= 0 = i18nCell $ MsgTableProportion (toMessage curr) (toMessage max') (toRational curr / toRational max')
  | otherwise = i18nCell $ MsgTableProportionNoRatio (toMessage curr) (toMessage 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 = cell . occurrencesWidget

roomReferenceCell :: IsDBTable m a => RoomReference -> DBCell m a
roomReferenceCell = cell . roomReferenceWidget

cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a
cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece

lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
  where 
    ic | isLmsSuccess ls = IconOK
       | otherwise       = IconNotOK