84 lines
3.1 KiB
Haskell
84 lines
3.1 KiB
Haskell
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 Language.Haskell.TH (Q, Exp)
|
|
-- import Language.Haskell.TH.Datatype
|
|
|
|
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.Templates 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}|]
|
|
|
|
nameWidget :: Text -> Text -> Widget
|
|
nameWidget displayName surname = toWidget $ nameHtml displayName surname
|
|
|
|
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."
|
|
|
|
|
|
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") |