8_d_1: Add solution

2 files changed, 102 insertions, 1 deletions

diff --git a/README.md b/README.md
index 64903c0..14ce202 100644
--- a/README.md
+++ b/README.md
@@ -123,7 +123,7 @@ are prefixed with 'Module_'.
 | 8_b_3          | yes    |      | |
 | **_Module_8_c_1_** | yes    | 211  | |
 | 8_c_2          | yes    |      | |
-| **_8_d_1_**    |        | 212  | |
+| **_8_d_1_**    | yes    | 212  | |
 | **_9_a_1_**    |        | 221  | 9. I/O case study: a library for searching the filesystem |
 | **_9_b_1_**    |        | 228  | |
 | 9_b_2          |        |      | |
diff --git a/ch08/8_d_1.hs b/ch08/8_d_1.hs
new file mode 100644
index 0000000..8c2c47f
--- /dev/null
+++ b/ch08/8_d_1.hs
@@ -0,0 +1,101 @@
+-- Glob patterns are simple enough to interpret that it's easy to write a
+-- matcher directly in Haskell, rather than going through the regexp
+-- machinery. Give it a try.
+
+-- For simplifying this solution, only simple character sets are supported
+-- (e.g., no character ranges).
+
+import Text.Regex.Posix ((=~))
+import Data.List
+
+data GlobItem = Any | Set Bool [Char] | Star deriving (Show)
+
+{-- From examples/examples/ch08/GlobRegex.hs modified according to the assignment --}
+parseGlob :: String -> [GlobItem]
+parseGlob "" = []
+
+parseGlob ('*':cs) = Star : parseGlob cs
+
+parseGlob ('?':cs) = Any : parseGlob cs
+
+parseGlob ('[':'!':cs) = (Set True multiple) : parseGlob rest
+  where (multiple, rest) = charClass [] cs
+parseGlob ('[':cs)   = (Set False multiple) : parseGlob rest
+  where (multiple, rest) = charClass [] cs
+
+parseGlob (c:cs) = (Set False [c]) : parseGlob cs
+
+
+charClass :: String -> String -> (String, String)
+charClass multiple (']':cs) = (multiple, cs)
+charClass multiple (c:cs)   = charClass (multiple ++ [c]) cs
+charClass _ []              = error "unterminated character class"
+
+
+matchesGlob :: String -> String -> Bool
+matchesGlob glob str = matchesGlob' (parseGlob glob) str
+{-- End of code from examples --}
+
+matchesGlob' :: [GlobItem] -> String -> Bool
+matchesGlob' (Any:gs) (c:cs) = matchesGlob' gs cs
+matchesGlob' ((Set complement list):gs) (c:cs) = if doesMatch
+                                                 then matchesGlob' gs cs
+                                                 else False
+  where doesMatch = if complement
+                    then all (\x -> x /= c) list
+                    else any (\x -> x == c) list
+matchesGlob' (Star:gs) cs = any (\x -> matchesGlob' gs x) (reverse (tails cs))
+
+matchesGlob' [] [] = True
+matchesGlob' [] (c:cs) = False
+matchesGlob' (g:gs) [] = False
+
+
+-- ghci> :l 8_d_1.hs
+-- [1 of 1] Compiling Main             ( 8_d_1.hs, interpreted )
+-- Ok, one module loaded.
+
+-- ghci> matchesGlob "" "hello"
+-- False
+
+-- ghci> matchesGlob "h?llo" "hello"
+-- True
+
+-- ghci> matchesGlob "h?ll" "hello"
+-- False
+
+-- ghci> matchesGlob "h?llo" "hello!"
+-- False
+
+-- ghci> matchesGlob "h[eCD]llo" "hello"
+-- True
+
+-- ghci> matchesGlob "h[!eCD]llo" "hello"
+-- False
+
+-- ghci> matchesGlob "h[!XYz]llo" "hello"
+-- True
+
+-- ghci> matchesGlob "*" "hello"
+-- True
+
+-- ghci> matchesGlob "he*o" "hello"
+-- True
+
+-- ghci> matchesGlob "he*" "hello"
+-- True
+
+-- ghci> matchesGlob "he*y" "hello"
+-- False
+
+-- ghci> matchesGlob "h*e*o" "hello"
+-- True
+
+-- ghci> matchesGlob "[!abc][eFG]*Y" "hello"
+-- False
+
+-- ghci> matchesGlob "[!abc][eFG]*o" "hello"
+-- True
+
+-- ghci> matchesGlob "a*c" "abcabc"
+-- True