From dad3806bfeaab18eb607f4dfb72cfdadead5fe9e Mon Sep 17 00:00:00 2001
From: sabadev <saba@sabadev.xyz>
Date: Sat, 20 Mar 2021 14:41:03 -0400
Subject: [PATCH] Added logic for parsing and generating query parameters for
 the theme.

---
 src/Html.hs | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/src/Html.hs b/src/Html.hs
index 466c9c5..9381cb2 100644
--- 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
 
-- 
2.20.1