module Handler.Utils.Widgets where

import Import
import qualified Data.Text as T
import qualified Data.CaseInsensitive as CI

import Text.Hamlet (shamletFile)

import Handler.Utils.DateTime

import qualified Data.Char as Char


---------
-- Simple utilities for consistent display
-- Please use these throughout, to ensure that users have a consistent experience

tidFromText :: Text -> Maybe TermId
tidFromText = fmap TermKey . maybeRight . termFromText

-- | Display given UTCTime and maybe an invisible icon if it is in the future
--
--   Also see `Handler.Utils.Table.Cells.dateTimeCellVisible` for a similar function (in case of refactoring)
visibleUTCTime :: SelDateTimeFormat -> UTCTime -> Widget
visibleUTCTime dtf t = do
    let timeStampWgt = formatTimeW dtf t
    now <- liftIO getCurrentTime
    if now >= t
      then timeStampWgt
      else $(widgetFile "widgets/date-time/yet-invisible")


-- | Simple link to a known route
simpleLink :: Widget -> Route UniWorX -> Widget
simpleLink lbl url = [whamlet|<a href=@{url}>^{lbl}|]

simpleLinkI :: SomeMessage UniWorX -> Route UniWorX -> Widget
simpleLinkI lbl url = [whamlet|<a href=@{url}>_{lbl}|]

-- | toWidget-Version of @nameHtml@, for convenience
nameWidget :: Text    -- ^ userDisplayName
           -> Text    -- ^ userSurname
           -> Widget
nameWidget displayName surname = toWidget $ nameHtml displayName surname

-- | toWidget-Version of @nameEmailHtml@, for convenience
nameEmailWidget :: UserEmail -- ^ userEmail
                -> Text    -- ^ userDisplayName
                -> Text    -- ^ userSurname
                -> Widget
nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname

-- | uncurried Version for @nameEmailWidget@ needed in hamlet, where TH cannot be used
nameEmailWidget' :: (UserEmail, Text, Text)-> Widget
nameEmailWidget' = $(uncurryN 3) nameEmailWidget

-- | Show user's displayName, highlighting the surname if possible.
--   Otherwise appends the surname in parenthesis
nameHtml :: Text -> Text -> Html
nameHtml displayName surname
  | null surname = toHtml displayName
  | otherwise = case reverse $ T.splitOn surname displayName of
      [_notContained] -> [shamlet|$newline never
                            #{displayName} (
                            <b .surname>#{surname}
                            )|]
      (suffix:prefixes) ->
        let prefix = T.intercalate surname $ reverse prefixes
        in [shamlet|$newline never
              #{prefix}
              <b .surname>#{surname}
              #{suffix}
            |]
      [] -> error "Data.Text.splitOn returned empty list in violation of specification."

-- | Like nameHtml just show a users displayname with hightlighted surname,
--   but also wrap the name with a mailto-link
nameEmailHtml :: UserEmail -> Text -> Text -> Html
nameEmailHtml email displayName surname =
  wrapMailto email $ nameHtml displayName surname

-- | Wrap mailto around given Html using single hamlet-file for consistency
wrapMailto :: UserEmail -> Html -> Html
wrapMailto (CI.original -> email) linkText
  | null email = linkText
  | otherwise  = $(shamletFile "templates/widgets/link-email.hamlet")

-- | Just show an email address in a standard way, for convenience inside hamlet files.
mailtoHtml :: UserEmail -> Html
mailtoHtml email = wrapMailto email $(shamletFile "templates/widgets/email.hamlet")

-- | Generic i18n text for "edited at sometime by someone"
editedByW :: SelDateTimeFormat -> UTCTime -> Text -> Widget
editedByW fmt tm usr  = do
  ft <- handlerToWidget $ formatTime fmt tm
  [whamlet|_{MsgEditedBy usr ft}|]

heat :: Integral a => a -> a -> Double
heat (toInteger -> full) (toInteger -> achieved)
  = roundToDigits 3 $ cutOffPercent 0.3 (fromIntegral full^2) (fromIntegral achieved^2)

i18n :: forall m msg.
        ( MonadWidget m
        , RenderMessage (HandlerSite m) msg
        ) => msg -> m ()
i18n = toWidget . (SomeMessage :: msg -> SomeMessage (HandlerSite m))


examOccurrenceMappingDescriptionWidget :: ExamOccurrenceRule -> Set ExamOccurrenceMappingDescription -> Widget
examOccurrenceMappingDescriptionWidget rule descriptions = $(widgetFile "widgets/exam-occurrence-mapping-description")
  where
    titleCase :: [CI Char] -> String
    titleCase = over _head Char.toUpper . map CI.foldedCase
    doPrefix
      | ExamRoomMatriculation <- rule
      = False
      | otherwise
      = True