fradrive/src/Handler/Info.hs
2019-10-08 15:28:56 +02:00

70 lines
2.6 KiB
Haskell

module Handler.Info where
import Import
import Handler.Utils
import Development.GitRev
-- | Versionsgeschichte
getVersionR :: Handler TypedContent
getVersionR = selectRep $ do
provideRep $
return ($gitDescribe :: Text)
provideRep getInfoR
-- | Impressum
getImpressumR :: Handler Html
getImpressumR = -- do
siteLayoutMsg' MsgMenuImpressum $ do
setTitleI MsgImpressumHeading
$(i18nWidgetFile "imprint")
-- | Hinweise zu Datenschutz und Aufbewahrungspflichten
getDataProtR :: Handler Html
getDataProtR = -- do
siteLayoutMsg' MsgMenuDataProt $ do
setTitleI MsgDataProtHeading
$(i18nWidgetFile "data-protection")
-- | 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 tooltipNew (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 tooltipNewU2W (Just IconNew) False} |]