From f5d1d49e3320e3f5407f77f232e4dcb1bb5ba380 Mon Sep 17 00:00:00 2001 From: Jan Sucan Date: Sun, 3 Sep 2023 11:57:33 +0200 Subject: 8_c_2: Add solution --- README.md | 7 ++- ch08/8_c_1.hs | 79 --------------------------------- ch08/8_c_2.hs | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++ ch08/Module_8_c_1.hs | 81 +++++++++++++++++++++++++++++++++ 4 files changed, 210 insertions(+), 80 deletions(-) delete mode 100644 ch08/8_c_1.hs create mode 100644 ch08/8_c_2.hs create mode 100644 ch08/Module_8_c_1.hs diff --git a/README.md b/README.md index eee4d1b..134e7cc 100644 --- a/README.md +++ b/README.md @@ -62,12 +62,17 @@ includes solutions that could have been made multiplatform. ### List of the exercises -Format of an exercise label is '\\_\\_\'. Some +Format of an exercise label is '{Module_}\\_\\_\'. 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_1.hs b/ch08/8_c_1.hs deleted file mode 100644 index ce80ade..0000000 --- a/ch08/8_c_1.hs +++ /dev/null @@ -1,79 +0,0 @@ --- Write a version of globToRegex that uses the type signature earlier. - -{-- From examples/examples/ch08/GlobRegex.hs modified according to the assignment --} -import Text.Regex.Posix ((=~)) - -type GlobError = String - -globToRegex :: String -> Either GlobError String - -globToRegex cs = propagateError regex - where regex = globToRegex' cs - propagateError (Left e) = Left e - propagateError (Right s) = Right ('^' : s ++ "$") - -globToRegex' :: String -> Either GlobError String -globToRegex' "" = Right "" - -globToRegex' ('*':cs) = propagateError regex - where regex = globToRegex' cs - propagateError (Left e) = Left e - propagateError (Right s) = Right (".*" ++ s) - -globToRegex' ('?':cs) = propagateError regex - where regex = globToRegex' cs - propagateError (Left e) = Left e - propagateError (Right s) = Right ("." ++ s) - -globToRegex' ('[':'!':c:cs) = propagateError charCls - where charCls = charClass cs - propagateError (Left e) = Left e - propagateError (Right s) = Right ("[^" ++ c : s) - -globToRegex' ('[':c:cs) = propagateError charCls - where charCls = charClass cs - propagateError (Left e) = Left e - propagateError (Right s) = Right ('[' : c : s) - -globToRegex' ('[':_) = Left "unterminated character class" - -globToRegex' (c:cs) = propagateError regex - where regex = globToRegex' cs - propagateError (Left e) = Left e - propagateError (Right s) = Right ((escape c) ++ s) - - -escape :: Char -> String -escape c | c `elem` regexChars = '\\' : [c] - | otherwise = [c] - where regexChars = "\\+()^$.{}]|" - - -charClass :: String -> Either GlobError String - -charClass (']':cs) = propagateError regex - where regex = globToRegex' cs - propagateError (Left e) = Left e - propagateError (Right s) = Right (']' : s) - -charClass (c:cs) = propagateError charCls - where charCls = charClass cs - propagateError (Left e) = Left e - propagateError (Right s) = Right (c : s) - -charClass [] = Left "unterminated character class" -{-- End of code from examples --} - - --- ghci> :l 8_c_1.hs --- [1 of 1] Compiling Main ( 8_c_1.hs, interpreted ) --- Ok, one module loaded. - --- ghci> globToRegex "[" --- Left "unterminated character class" - --- ghci> globToRegex "[]" --- Left "unterminated character class" - --- ghci> globToRegex "a?b*c[!DE][FG]+" --- Right "^a.b.*c[^DE][FG]\\+$" 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/Module_8_c_1.hs b/ch08/Module_8_c_1.hs new file mode 100644 index 0000000..d8a2588 --- /dev/null +++ b/ch08/Module_8_c_1.hs @@ -0,0 +1,81 @@ +-- 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 ((=~)) + +type GlobError = String + +globToRegex :: String -> Either GlobError String + +globToRegex cs = propagateError regex + where regex = globToRegex' cs + propagateError (Left e) = Left e + propagateError (Right s) = Right ('^' : s ++ "$") + +globToRegex' :: String -> Either GlobError String +globToRegex' "" = Right "" + +globToRegex' ('*':cs) = propagateError regex + where regex = globToRegex' cs + propagateError (Left e) = Left e + propagateError (Right s) = Right (".*" ++ s) + +globToRegex' ('?':cs) = propagateError regex + where regex = globToRegex' cs + propagateError (Left e) = Left e + propagateError (Right s) = Right ("." ++ s) + +globToRegex' ('[':'!':c:cs) = propagateError charCls + where charCls = charClass cs + propagateError (Left e) = Left e + propagateError (Right s) = Right ("[^" ++ c : s) + +globToRegex' ('[':c:cs) = propagateError charCls + where charCls = charClass cs + propagateError (Left e) = Left e + propagateError (Right s) = Right ('[' : c : s) + +globToRegex' ('[':_) = Left "unterminated character class" + +globToRegex' (c:cs) = propagateError regex + where regex = globToRegex' cs + propagateError (Left e) = Left e + propagateError (Right s) = Right ((escape c) ++ s) + + +escape :: Char -> String +escape c | c `elem` regexChars = '\\' : [c] + | otherwise = [c] + where regexChars = "\\+()^$.{}]|" + + +charClass :: String -> Either GlobError String + +charClass (']':cs) = propagateError regex + where regex = globToRegex' cs + propagateError (Left e) = Left e + propagateError (Right s) = Right (']' : s) + +charClass (c:cs) = propagateError charCls + where charCls = charClass cs + propagateError (Left e) = Left e + propagateError (Right s) = Right (c : s) + +charClass [] = Left "unterminated character class" +{-- End of code from examples --} + + +-- ghci> :l 8_c_1.hs +-- [1 of 1] Compiling Main ( 8_c_1.hs, interpreted ) +-- Ok, one module loaded. + +-- ghci> globToRegex "[" +-- Left "unterminated character class" + +-- ghci> globToRegex "[]" +-- Left "unterminated character class" + +-- ghci> globToRegex "a?b*c[!DE][FG]+" +-- Right "^a.b.*c[^DE][FG]\\+$" -- cgit v1.2.3