diff --git a/config/routes b/config/routes index a029cd4..2c5dca1 100644 --- a/config/routes +++ b/config/routes @@ -20,7 +20,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/highlight.css HighlightStyleR GET +/highlight/#Text/style.css HighlightStyleR GET -- ---------------------------------------------------------------------------- -- Federation diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 48e72ec..29a5592 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -363,14 +363,9 @@ postRepoDevR shr rp dev = do Just "DELETE" -> deleteRepoDevR shr rp dev _ -> notFound -getHighlightStyleR :: Handler TypedContent -getHighlightStyleR = do - styleName <- do - ms <- lookupGetParam "style" - case ms of - Nothing -> getsYesod $ appHighlightStyle . appSettings - Just s -> return $ unpack s - case lookup styleName highlightingStyles of +getHighlightStyleR :: Text -> Handler TypedContent +getHighlightStyleR styleName = + case lookup (unpack styleName) highlightingStyles of Nothing -> notFound Just style -> return $ TypedContent typeCss $ toContent $ styleToCss style diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs index 87e25ce..7d70226 100644 --- a/src/Vervis/Handler/Repo/Darcs.hs +++ b/src/Vervis/Handler/Repo/Darcs.hs @@ -85,8 +85,11 @@ getDarcsRepoSource repository user repo dir = do dirs = zip parent (tail $ inits parent) defaultLayout $ do ms <- lookupGetParam "style" - let mparam = ("style",) <$> ms - addStylesheetAttrs HighlightStyleR $ maybeToList mparam + style <- + case ms of + Nothing -> getsYesod $ appHighlightStyle . appSettings + Just s -> return s + addStylesheet $ HighlightStyleR style $(widgetFile "repo/source-darcs") getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index 0121c28..8a764e0 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Handler/Repo/Git.hs @@ -95,8 +95,11 @@ getGitRepoSource repository user repo ref dir = do dirs = zip parent (tail $ inits parent) defaultLayout $ do ms <- lookupGetParam "style" - let mparam = ("style",) <$> ms - addStylesheetAttrs HighlightStyleR $ maybeToList mparam + style <- + case ms of + Nothing -> getsYesod $ appHighlightStyle . appSettings + Just s -> return s + addStylesheet $ HighlightStyleR style $(widgetFile "repo/source-git") getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index 96a77a9..55740e5 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -43,6 +43,9 @@ import Text.Pandoc.Highlighting import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, widgetFileReload) + +import qualified Data.Text as T + import Yesod.Mail.Send (MailSettings) -- | Runtime settings to configure this application. These settings can be @@ -158,7 +161,7 @@ data AppSettings = AppSettings -- | Default color scheme for syntax highlighting of code blocks inside -- documentes rendered with pandoc. - , appHighlightStyle :: String + , appHighlightStyle :: Text } instance FromJSON AppSettings where @@ -214,7 +217,7 @@ instance FromJSON AppSettings where s <- o .:? "highlight-style" .!= "zenburn" case lookup s highlightingStyles of Nothing -> fail $ "Highlighting style " ++ s ++ " not found" - Just _ -> return s + Just _ -> return $ T.pack s return AppSettings {..} where