8_c_2: Add solution

2 files changed, 125 insertions, 0 deletions

diff --git a/ch08/8_c_2.hs b/ch08/8_c_2.hs
new file mode 100644
index 0000000..0c37834
--- /dev/null
+++ b/ch08/8_c_2.hs
@@ -0,0 +1,123 @@
+-- Modify the type signature of namesMatching so that it encodes the possibility
+-- of a bad pattern, and make it use your rewritten globToRegex function.
+
+{-- From examples/examples/ch08/Glob.hs modified according to the assignment --}
+ --
+ -- An error in the listMatches function has been fixed as described in the
+ -- solution of 8_a_2.hs.
+ --}
+import Module_8_c_1 (GlobError, globToRegex)
+
+import Text.Regex.Posix ((=~))
+
+import Control.Exception
+import Control.Monad (forM)
+
+import System.Directory (doesDirectoryExist, doesFileExist,
+                         getCurrentDirectory, getDirectoryContents)
+
+import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>))
+
+{-- From examples/examples/ch08/GlobRegex.hs modified according to the assignment --}
+matchesGlob :: FilePath -> String -> Either GlobError Bool
+name `matchesGlob` pat = propagateError regex
+  where regex = globToRegex pat
+        propagateError (Left e) = Left e
+        propagateError (Right s) = Right (name =~ s)
+{-- End of code from examples --}
+
+namesMatching :: String -> IO (Either GlobError [FilePath])
+
+isPattern :: String -> Bool
+isPattern = any (`elem` "[*?")
+
+namesMatching pat
+  | not (isPattern pat) = do
+    exists <- doesNameExist pat
+    return (Right (if exists then [pat] else []))
+
+  | otherwise = do
+    case splitFileName pat of
+      ("", baseName) -> do
+          curDir <- getCurrentDirectory
+          listMatches curDir baseName
+      (dirName, baseName) -> do
+          dirs <- if isPattern dirName
+                  then namesMatching (dropTrailingPathSeparator dirName)
+                  else return (Right [dirName])
+          let listDir = if isPattern baseName
+                        then listMatches
+                        else listPlain
+          propagateErrorDirs dirs listDir baseName
+      where
+        propagateErrorDirs (Left e) _ _ = return (Left e)
+        propagateErrorDirs (Right dirs) listDir baseName =
+          propagateErrorListDirs dirs listDir baseName
+
+        propagateErrorListDirs [] _ _ = return (Right [])
+        propagateErrorListDirs (d:ds) listDir baseName = do
+          baseNames <- listDir d baseName
+          rest <- propagateErrorListDirs ds listDir baseName
+          propagateError d baseNames rest
+          where propagateError _ (Left e) _ = return (Left e)
+                propagateError _ _ (Left e) = return (Left e)
+                propagateError dir (Right baseNames) (Right rest)= do
+                  let dirBaseNames = map (dir </>) baseNames
+                  return (Right (dirBaseNames ++ rest))
+
+listMatches :: FilePath -> String -> IO (Either GlobError [String])
+listMatches dirName pat = do
+    dirName' <- if null dirName
+                then getCurrentDirectory
+                else return dirName
+    handle (\(SomeException _) -> return (Right [])) $ do
+        names <- getDirectoryContents dirName'
+        let names' = if isHidden pat
+                     then filter isHidden names
+                     else filter (not . isHidden) names
+        return (filterGlobError names' pat)
+
+filterGlobError :: [String] -> String -> Either GlobError [String]
+filterGlobError [] _ = Right []
+filterGlobError (n:ns) pat = propagateErrorConcat match filteredRest
+  where match = matchesGlob n pat
+        filteredRest = filterGlobError ns pat
+        propagateErrorConcat (Left e) _ = Left e
+        propagateErrorConcat _ (Left e) = Left e
+        propagateErrorConcat (Right matches) (Right rs) = Right (if matches then n:rs else rs)
+
+isHidden ('.':_) = True
+isHidden _       = False
+
+listPlain :: FilePath -> String -> IO (Either GlobError [String])
+listPlain dirName baseName = do
+    exists <- if null baseName
+              then doesDirectoryExist dirName
+              else doesNameExist (dirName </> baseName)
+    return (Right (if exists then [baseName] else []))
+
+doesNameExist :: FilePath -> IO Bool
+doesNameExist name = do
+    fileExists <- doesFileExist name
+    if fileExists
+      then return True
+      else doesDirectoryExist name
+{-- End of code from examples --}
+
+
+-- ghci> :l 8_c_2.hs
+-- [1 of 2] Compiling Module_8_c_1     ( Module_8_c_1.hs, interpreted )
+-- [2 of 2] Compiling Main             ( 8_c_2.hs, interpreted )
+-- Ok, two modules loaded.
+
+-- ghci> namesMatching "*.hs"
+-- Right ["./8_b_3.hs","./8_a_2.hs","./8_a_1.hs","./GlobRegex.hs","./8_c_2.hs","./Module_8_c_1.hs"]
+
+-- ghci> namesMatching "*/[d]*/*.c"
+-- Right ["./test-8_b_3/dir1/A.c","./test-8_b_3/dir1/B.c"]
+
+-- ghci> namesMatching "*/[/*.c"
+-- Left "unterminated character class"
+
+-- ghci> namesMatching "*/[]/*.c"
+-- Left "unterminated character class"
diff --git a/ch08/8_c_1.hs b/ch08/Module_8_c_1.hs
index ce80ade..d8a2588 100644
--- a/ch08/8_c_1.hs
+++ b/ch08/Module_8_c_1.hs
@@ -1,5 +1,7 @@
 -- Write a version of globToRegex that uses the type signature earlier.
 
+module Module_8_c_1 (GlobError, globToRegex) where
+
 {-- From examples/examples/ch08/GlobRegex.hs modified according to the assignment --}
 import Text.Regex.Posix ((=~))