}
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 <- 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."
+ parseQueryParam (T.splitOn "," -> [lightText, redText, greenText, blueText]) = do
+ let parseColorComponent = pure . flip mod 0x100 <=< parseQueryParam
+ light <- parseQueryParam lightText
+ red <- parseColorComponent redText
+ green <- parseColorComponent greenText
+ blue <- parseColorComponent blueText
+ pure $ Theme { themeType = light, themeRed = red, themeGreen = green, themeBlue = blue }
+ parseQueryParam theme = Left $ "Invalid value '" <> theme <> "'. Value must contain four integer values delimited by commas."
instance ToHttpApiData Theme where
toQueryParam theme = toQueryParam (themeType theme) <> "," <> toQueryParam (themeRed theme) <> "," <> toQueryParam (themeGreen theme) <> "," <> toQueryParam (themeBlue theme)
blogList theme = liftIO $ getDirectoryContents staticPath >>= pure . foldMap (blogListItem theme) . filter (T.isSuffixOf markdownExtension) . fmap T.pack
blogListItem :: Maybe Theme -> T.Text -> Html ()
-blogListItem theme path = do
- case blogLink path of
- Nothing -> pure $ mempty
- Just file -> li_ [class_ "blog-link"] $ a_ [href_ $ safeBlogLink theme $ T.unpack file] $ toHtml file
+blogListItem theme (blogLink -> Nothing) = pure $ mempty
+blogListItem theme (blogLink -> (Just file)) = li_ [class_ "blog-link"] $ a_ [href_ $ safeBlogLink theme $ T.unpack file] $ toHtml file
blogLink :: T.Text -> Maybe T.Text
blogLink = T.stripSuffix markdownExtension