diff options
| -rw-r--r-- | README.md | 7 | ||||
| -rw-r--r-- | ch08/8_c_2.hs | 123 | ||||
| -rw-r--r-- | ch08/Module_8_c_1.hs (renamed from ch08/8_c_1.hs) | 2 |
3 files changed, 131 insertions, 1 deletions
@@ -62,12 +62,17 @@ includes solutions that could have been made multiplatform. ### List of the exercises -Format of an exercise label is '\<chapter\>\_\<group\>\_\<exercise\>'. Some +Format of an exercise label is '{Module_}\<chapter\>\_\<group\>\_\<exercise\>'. Some chapters contain more groups of exercises. To differentiate those, an exercise group letter is included (the exact letters don't have a connection to the book). To make the exercise groups more visible in the list the first exercise of a group is in bold italics. +If a solution is intended to be used in solutions to other exercises, to reduce code +duplication, it is imported as a Haskell module. For this to work, the naming +conventions for Haskell modules need to be followed. The names of such source files +are prefixed with 'Module_'. + | Exercise | Solved | Page | Chapter | | -------------- | ------ | ---- | ------- | 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 ((=~)) |