From 9d17441ebe6f909c4aab2e730d3971a10a48b9b0 Mon Sep 17 00:00:00 2001 From: sabadev Date: Mon, 22 Mar 2021 21:07:38 -0400 Subject: [PATCH] Inverted the Html-ApiTypes dependency relationship. --- src/ApiTypes.hs | 35 ++++++++++++++++++++++++++++++++++- src/Html.hs | 34 +--------------------------------- 2 files changed, 35 insertions(+), 34 deletions(-) diff --git a/src/ApiTypes.hs b/src/ApiTypes.hs index 47a95f3..7a3dd90 100644 --- a/src/ApiTypes.hs +++ b/src/ApiTypes.hs @@ -1,11 +1,11 @@ module ApiTypes where import CssContentType -import Html import Lucid import Servant import Servant.HTML.Lucid (HTML(..)) import qualified Clay as C +import qualified Data.Text as T type Api = Page :<|> Themes type Page = MainPage :<|> BlogPost @@ -16,6 +16,39 @@ type DarkTheme = "style" :> "dark" :> QueryParam "red" Integer :> QueryParam "gr type LightTheme = "style" :> "light" :> QueryParam "red" Integer :> QueryParam "green" Integer :> QueryParam "blue" Integer :> Get '[CSS] C.Css type ThemeParam = QueryParam "theme" Theme +type BlogId = FilePath + +data LightDark = Light | Dark deriving (Eq) + +instance FromHttpApiData LightDark where + parseQueryParam "0" = Right Dark + parseQueryParam "1" = Right Light + parseQueryParam x = Left $ "Invalid value " <> x <> ". Value must be either '0' or '1'." + +instance ToHttpApiData LightDark where + toQueryParam Dark = "0" + toQueryParam Light = "1" + +data Theme = Theme { themeType :: !LightDark + , themeRed :: !Integer + , themeGreen :: !Integer + , themeBlue :: !Integer + } + +instance FromHttpApiData Theme where + parseQueryParam theme = do + case T.splitOn "," theme of + [lightText, redText, greenText, blueText] -> do + light <- parseQueryParam lightText + red <- parseQueryParam redText + green <- parseQueryParam greenText + blue <- parseQueryParam blueText + pure $ Theme { themeType = light, themeRed = red, themeGreen = green, themeBlue = blue } + _ -> 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) + apiProxy :: Proxy Api apiProxy = Proxy diff --git a/src/Html.hs b/src/Html.hs index b2adbaf..4322820 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -1,5 +1,6 @@ module Html where +import ApiTypes import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..), liftIO) import Data.Maybe (fromMaybe) @@ -9,39 +10,6 @@ import System.Directory (getDirectoryContents) import qualified Data.Text as T import qualified Data.Text.IO as T -data LightDark = Light | Dark deriving (Eq) - -instance FromHttpApiData LightDark where - parseQueryParam "0" = Right Dark - parseQueryParam "1" = Right Light - parseQueryParam x = Left $ "Invalid value " <> x <> ". Value must be either '0' or '1'." - -instance ToHttpApiData LightDark where - toQueryParam Dark = "0" - toQueryParam Light = "1" - -data Theme = Theme { themeType :: !LightDark - , themeRed :: !Integer - , themeGreen :: !Integer - , themeBlue :: !Integer - } - -instance FromHttpApiData Theme where - parseQueryParam theme = do - case T.splitOn "," theme of - [lightText, redText, greenText, blueText] -> do - light <- parseQueryParam lightText - red <- parseQueryParam redText - green <- parseQueryParam greenText - blue <- parseQueryParam blueText - pure $ Theme { themeType = light, themeRed = red, themeGreen = green, themeBlue = blue } - _ -> 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) - -type BlogId = FilePath - htmlContainer :: (MonadIO m) => Maybe Theme -> Html a -> m (Html ()) htmlContainer theme contents = do nav <- navigation theme -- 2.20.1