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")