From c4559b3fecb77f69972bb0284442fffdbdc9cf1d Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Wed, 6 Aug 2025 15:56:28 +0200
Subject: 15_a_3: Add solution

---
 ch15/15_a_3.hs | 149 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 149 insertions(+)
 create mode 100644 ch15/15_a_3.hs

(limited to 'ch15')

diff --git a/ch15/15_a_3.hs b/ch15/15_a_3.hs
new file mode 100644
index 0000000..951a7e4
--- /dev/null
+++ b/ch15/15_a_3.hs
@@ -0,0 +1,149 @@
+-- In a form-encoded string, the same key may appear several times, with or
+-- without values, e.g. key&key=1&key=2. What type might you use to represent
+-- the values associated with a key in this sort of string? Write a parser that
+-- correctly captures all of the information.
+
+-- I will use Map String [String] where the values are lists of values for a
+-- urlencoded-key. Empty list indicates no values for the key.
+
+{-- From examples/examples/ch10/Parse.hs and modified:
+ --   removed unused code,
+ --   made Parse an instance of Applicative,
+ --   used the do notation as this chapter is "Programming with monads".
+ --}
+import Data.Map
+
+data ParseState = ParseState {
+      string :: String
+    } deriving (Show)
+
+
+newtype Parse a = Parse {
+      runParse :: ParseState -> (a, ParseState)
+    }
+
+(==>) :: Parse a -> (a -> Parse b) -> Parse b
+firstParser ==> makeSecondParser  =  Parse chainedParser
+  where chainedParser initState = runParse (makeSecondParser firstResult) newState
+          where
+            (firstResult, newState) = runParse firstParser initState
+
+identity :: a -> Parse a
+identity a = Parse (\s -> (a, s))
+
+instance Functor Parse where
+    fmap f parser = parser ==> \result ->
+                    identity (f result)
+
+instance Applicative Parse where
+  pure = identity
+  parFunc <*> parVal =
+    parVal ==> \v ->
+    parFunc ==> \f ->
+    pure (f v)
+
+instance Monad Parse where
+    return = pure
+    (>>=) = (==>)
+
+parse :: Parse a -> String -> a
+parse parser initState = fst (runParse parser (ParseState initState))
+
+getState :: Parse ParseState
+getState = Parse (\s -> (s, s))
+
+putState :: ParseState -> Parse ()
+putState s = Parse (\_ -> ((), s))
+
+parseChar :: Parse (Maybe Char)
+parseChar = do
+    initState <- getState
+    case string initState of
+      [] ->
+          return Nothing
+      (char:remainder) -> do
+          putState newState
+          return (Just char)
+        where newState = initState { string = remainder }
+
+peekChar :: Parse (Maybe Char)
+peekChar = (safeHead . string) <$> getState
+  where safeHead [] = Nothing
+        safeHead (x:xs) = Just x
+
+parseWhile :: (Char -> Bool) -> Parse String
+parseWhile p = do
+  mp <- (fmap p <$> peekChar)
+  if mp == Just True
+    then do
+      mc <- parseChar
+      case mc of
+        Nothing -> return []
+        Just c -> (c:) <$> parseWhile p
+    else return []
+{-- End of code from examples --}
+
+
+parseKey :: Parse String
+parseKey = parseWhile isKeyEnd
+  where isKeyEnd c = (c /= '&' && c /= '=')
+
+parseValue :: Parse String
+parseValue = do
+  c <- peekChar
+  case c of
+    Nothing  -> return ""
+    Just '&' -> do
+      -- No value.
+      -- Consume the end character so that the next parseKey starts from the
+      -- first character of the next key.
+      parseChar
+      return ""
+    Just '=' -> do
+      -- Consume the '='
+      parseChar
+      v <- parseWhile isValueEnd
+      -- Consume the end character
+      parseChar
+      return v
+  where isValueEnd c = (c /= '&')
+
+parseKeyValuePairs :: Parse (Map String [String])
+parseKeyValuePairs = do
+  k <- parseKey
+  case k of
+    "" -> return empty
+    _  -> do
+      v <- parseValue
+      case v of
+        "" -> (insertWith (++) k []) <$> parseKeyValuePairs
+        _  -> (insertWith (++) k [v]) <$> parseKeyValuePairs
+
+
+-- ghci> :l 15_a_3.hs
+-- [1 of 2] Compiling Main             ( 15_a_3.hs, interpreted )
+-- Ok, one module loaded.
+
+-- ghci> parse parseKeyValuePairs ""
+-- fromList []
+
+-- ghci> parse parseKeyValuePairs "key"
+-- fromList [("key",[])]
+
+-- ghci> parse parseKeyValuePairs "key&"
+-- fromList [("key",[])]
+
+-- ghci> parse parseKeyValuePairs "key="
+-- fromList [("key",[])]
+
+-- ghci> parse parseKeyValuePairs "key=123"
+-- fromList [("key",["123"])]
+
+-- ghci> parse parseKeyValuePairs "key=123&"
+-- fromList [("key",["123"])]
+
+-- ghci> parse parseKeyValuePairs "key&key=1&key=2"
+-- fromList [("key",["1","2"])]
+
+-- ghci> parse parseKeyValuePairs "key&foo=4&key=2&foo=&bar&key=&foo=3&key=1&foo&key=0"
+-- fromList [("bar",[]),("foo",["4","3"]),("key",["2","1","0"])]
-- 
cgit v1.2.3