Use path segment in HighlightStyleR, addStylesheet doesn't support query params

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

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 :: Text -> Handler TypedContent
-getHighlightStyleR = do
+getHighlightStyleR styleName =
-    styleName <- do
+    case lookup (unpack styleName) highlightingStyles of
-        ms <- lookupGetParam "style"
-        case ms of
-            Nothing -> getsYesod $ appHighlightStyle . appSettings
-            Just s -> return $ unpack s
-    case lookup styleName highlightingStyles of
         Nothing -> notFound
         Just style ->
             return $ TypedContent typeCss $ toContent $ styleToCss style

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
+                style <-
-                addStylesheetAttrs HighlightStyleR $ maybeToList mparam
+                    case ms of
+                        Nothing -> getsYesod $ appHighlightStyle . appSettings
+                        Just s -> return s
+                addStylesheet $ HighlightStyleR style
                 $(widgetFile "repo/source-darcs")
 
 getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent

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
+                style <-
-                addStylesheetAttrs HighlightStyleR $ maybeToList mparam
+                    case ms of
+                        Nothing -> getsYesod $ appHighlightStyle . appSettings
+                        Just s -> return s
+                addStylesheet $ HighlightStyleR style
                 $(widgetFile "repo/source-git")
 
 getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent

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