From: sabadev Date: Tue, 23 Mar 2021 02:00:39 +0000 (-0400) Subject: Simplified theme parsing logic. X-Git-Url: http://sabadev.xyz:4321/?a=commitdiff_plain;h=43bb8012ca494039bf5c907bc4cd2d6315358400;p=website.git Simplified theme parsing logic. --- diff --git a/src/ApiTypes.hs b/src/ApiTypes.hs index 7a8c0a0..bd0342a 100644 --- 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 --- 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