86 lines
3.2 KiB
Haskell
86 lines
3.2 KiB
Haskell
module Handler.Info where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Info.TH
|
|
|
|
import qualified Data.Map as Map
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import Development.GitRev
|
|
|
|
-- | Versionsgeschichte
|
|
getVersionR :: Handler TypedContent
|
|
getVersionR = selectRep $ do
|
|
provideRep $
|
|
return ($gitDescribe :: Text)
|
|
provideRep getInfoR
|
|
|
|
|
|
-- | Datenschutzerklaerung und Aufbewahrungspflichten, Nutzungsbedingungen, Urheberrecht, Impressum
|
|
getLegalR :: Handler Html
|
|
getLegalR =
|
|
siteLayoutMsg' MsgMenuLegal $ do
|
|
setTitleI MsgLegalHeading
|
|
let dataProtection = $(i18nWidgetFile "data-protection")
|
|
termsUse = $(i18nWidgetFile "terms-of-use")
|
|
copyright = $(i18nWidgetFile "copyright")
|
|
imprint = $(i18nWidgetFile "imprint")
|
|
$(widgetFile "legal")
|
|
|
|
|
|
-- | Allgemeine Informationen
|
|
getInfoR :: Handler Html
|
|
getInfoR = -- do
|
|
siteLayoutMsg MsgInfoHeading $ do
|
|
setTitleI MsgInfoHeading
|
|
let features = $(i18nWidgetFile "featureList")
|
|
changeLog = $(i18nWidgetFile "changelog")
|
|
knownBugs = $(i18nWidgetFile "knownBugs")
|
|
implementation = $(i18nWidgetFile "implementation")
|
|
gitInfo :: Text
|
|
gitInfo = $gitDescribe <> " (" <> $gitCommitDate <> ")"
|
|
$(widgetFile "versionHistory")
|
|
|
|
|
|
getInfoLecturerR :: Handler Html
|
|
getInfoLecturerR =
|
|
siteLayoutMsg' MsgInfoLecturerTitle $ do
|
|
setTitleI MsgInfoLecturerTitle
|
|
$(i18nWidgetFile "info-lecturer")
|
|
where
|
|
tooltipNew, tooltipProblem, tooltipPlanned, tooltipNewU2W :: WidgetFor UniWorX ()
|
|
tooltipNew = [whamlet| _{MsgLecturerInfoTooltipNew} |]
|
|
tooltipProblem = [whamlet| _{MsgLecturerInfoTooltipProblem} |]
|
|
tooltipPlanned = [whamlet| _{MsgLecturerInfoTooltipPlanned} |]
|
|
tooltipNewU2W = [whamlet| _{MsgLecturerInfoTooltipNewU2W} |]
|
|
newU2WFeat, probFeatInline, plannedFeat, plannedFeatInline :: WidgetFor UniWorX ()
|
|
newU2WFeat = [whamlet| ^{iconTooltip tooltipNewU2W (Just IconAnnounce) True} |] -- to be used inside text blocks
|
|
probFeatInline = [whamlet| ^{iconTooltip tooltipProblem (Just IconProblem) True} |] -- to be used inside text blocks
|
|
plannedFeat = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) False} |]
|
|
plannedFeatInline = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) True} |] -- to be used inside text blocks
|
|
|
|
-- new feature with given introduction date
|
|
newFeat :: Integer -> Int -> Int -> WidgetFor UniWorX ()
|
|
newFeat year month day = do
|
|
currentTime <- liftIO getCurrentTime
|
|
let expiryTime = UTCTime (addGregorianMonthsRollOver 1 $ fromGregorian year month day) 0
|
|
if currentTime > expiryTime
|
|
then mempty
|
|
else toWidget [whamlet| ^{iconTooltip tooltipNew (Just IconNew) False} |]
|
|
|
|
getGlossaryR :: Handler Html
|
|
getGlossaryR =
|
|
siteLayoutMsg' MsgGlossaryTitle $ do
|
|
setTitleI MsgGlossaryTitle
|
|
MsgRenderer mr <- getMsgRenderer
|
|
let
|
|
entries' = sortOn (CI.mk . view _2) $ do
|
|
(k, v) <- Map.toList entries
|
|
msg <- maybeToList $ Map.lookup k msgMap
|
|
return (k, mr msg, v)
|
|
$(widgetFile "glossary")
|
|
where
|
|
entries = $(i18nWidgetFiles "glossary")
|
|
msgMap = $(glossaryTerms "glossary")
|