Added logic for parsing and generating query parameters for the theme.

diff --git a/src/Html.hs b/src/Html.hs
index 466c9c5..9381cb2 100644 (file)
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -4,18 +4,42 @@ import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..), liftIO)
 import Data.Maybe (fromMaybe)
 import Lucid
+import Servant
 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 UseLightTheme = Maybe Bool
 type BlogId = FilePath