module Handler.Utils
  ( module Handler.Utils
  ) where

import Import

import qualified Data.Text as T
-- import qualified Data.Set (Set)
import qualified Data.Set as Set
import Data.CaseInsensitive (CI, original)
-- import qualified Data.CaseInsensitive as CI

import Language.Haskell.TH (Q, Exp)
-- import Language.Haskell.TH.Datatype

import Text.Hamlet (shamletFile)

import Handler.Utils.DateTime as Handler.Utils
import Handler.Utils.Form as Handler.Utils
import Handler.Utils.Table as Handler.Utils
import Handler.Utils.Table.Pagination as Handler.Utils

import Handler.Utils.Zip        as Handler.Utils
import Handler.Utils.Rating     as Handler.Utils hiding (extractRatings)
-- import Handler.Utils.Submission as Handler.Utils
import Handler.Utils.Sheet      as Handler.Utils
import Handler.Utils.Mail       as Handler.Utils


downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool
downloadFiles = do
  mauth <- liftHandlerT maybeAuth
  case mauth of
    Just (Entity _ User{..}) -> return userDownloadFiles
    Nothing -> do
      AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings
      return userDefaultDownloadFiles

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

simpleLink :: Widget -> Route UniWorX -> Widget
simpleLink 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 :: CI Text -- ^ userEmail
                -> Text    -- ^ userDisplayName
                -> Text    -- ^ userSurname
                -> Widget
nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname

-- | 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 :: CI Text -> Text -> Text -> Html
nameEmailHtml email displayName surname =
  wrapMailto email $ nameHtml displayName surname

-- | Wrap mailto around given Html using single hamlet-file for consistency
wrapMailto :: CI Text -> Html -> Html
wrapMailto (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 :: CI Text -> Html
mailtoHtml email = wrapMailto email $ toHtml email

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

-- | Prefix a message with a short course id,
--   eg. for window title bars, etc.
--   This function should help to make this consistent everywhere
prependCourseTitle :: (RenderMessage UniWorX msg) =>
  TermId -> SchoolId -> CourseShorthand -> msg -> UniWorXMessages
prependCourseTitle tid ssh csh msg = UniWorXMessages
  [ SomeMessage $ toPathPiece tid
  , SomeMessage dashText
  , SomeMessage $ toPathPiece ssh
  , SomeMessage dashText
  , SomeMessage csh
  , SomeMessage colonText
  , SomeMessage msg
  ]
 where
    dashText :: Text
    dashText = "-"

    colonText :: Text
    colonText = ":"

warnTermDays :: TermId -> [Maybe UTCTime] -> DB ()
warnTermDays tid times = do
  Term{..} <- get404 tid
  let alldays       = Set.map utctDay $ Set.fromList $ catMaybes times
      warnholidays  = Set.intersection alldays $ Set.fromList termHolidays
      outoftermdays = Set.filter (\d -> d < termStart        || d > termEnd       ) alldays
      outoflecture  = Set.filter (\d -> d < termLectureStart || d > termLectureEnd) alldays
                        `Set.difference` outoftermdays -- out of term implies out of lecture-time
      warnI msg d = formatTime SelFormatDate d >>= \dt -> addMessageI Warning $ msg tid dt
  forM_ warnholidays  $ warnI MsgDayIsAHoliday
  forM_ outoflecture  $ warnI MsgDayIsOutOfLecture
  forM_ outoftermdays $ warnI MsgDayIsOutOfTerm

-- | Add language dependent template files
--   For large files which are translated as a whole.
--   Argument musst be a directory under templates,
--   which contains a file for each language,
--   eg. /templates/imprint/de.hamlet and /templates/imprint/en.hamlet
i18nWidgetFile :: FilePath -> Q Exp
i18nWidgetFile =
  -- TODO write code to distinguish languages here
  widgetFile . (</> "de")