Simplified theme parsing logic.

diff --git a/src/ApiTypes.hs b/src/ApiTypes.hs
index 7a8c0a0..bd0342a 100644 (file)
--- a/src/ApiTypes.hs
+++ b/src/ApiTypes.hs
@@ -1,5 +1,6 @@
 module ApiTypes where
 
+import Control.Monad ((<=<))
 import CssContentType
 import Lucid
 import Servant
@@ -37,10 +38,11 @@ instance FromHttpApiData Theme where
   parseQueryParam theme = do
     case T.splitOn "," theme of
       [lightText, redText, greenText, blueText] -> do
+        let parseColorComponent = pure . flip mod 0x100 <=< parseQueryParam
         light <- parseQueryParam lightText
-        red <- parseQueryParam redText
-        green <- parseQueryParam greenText
-        blue <- parseQueryParam blueText
+        red <- parseColorComponent redText
+        green <- parseColorComponent greenText
+        blue <- parseColorComponent blueText
         pure $ Theme { themeType = light, themeRed = red, themeGreen = green, themeBlue = blue }
       _ -> Left $ "Invalid value '" <> theme <> "'. Value must contain four integer values delimited by commas."
 

diff --git a/src/Server.hs b/src/Server.hs
index e21744a..9ac4c6e 100644 (file)
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -32,19 +32,9 @@ findBlogPost :: BlogId -> Handler T.Text
 findBlogPost = liftIO . T.readFile . (<>) staticPath . flip (<>) (T.unpack markdownExtension)
 
 styling :: Maybe Theme -> Handler C.Css
-styling Nothing = pure $ darkStyle $ getColorFromInput 0 0 0
-styling (Just theme) = pure $ getStyleFromTheme (themeType theme) $ getColorFromInput (themeRed theme) (themeGreen theme) (themeBlue theme)
+styling Nothing = pure $ darkStyle C.black
+styling (Just theme) = pure $ getStyleFromTheme (themeType theme) $ C.rgba (themeRed theme) (themeGreen theme) (themeBlue theme) 1
 
 getStyleFromTheme :: LightDark -> C.Color -> C.Css
 getStyleFromTheme Dark = darkStyle
 getStyleFromTheme Light = lightStyle
-
-getColorFromInput :: Integer -> Integer -> Integer -> C.Color
-getColorFromInput redColor greenColor blueColor = do
-  let red = getIndividualColor redColor
-  let green = getIndividualColor greenColor
-  let blue = getIndividualColor blueColor
-  C.rgba red green blue 1
-
-getIndividualColor :: Integer -> Integer
-getIndividualColor = flip mod 0x100