1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
-- 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.
-- For simplicity, I will not handle the encoding of spaces, reserved
-- characters, and non-ASCII characters in the urlencoded string.
{-- 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"])]
|
