diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs index 9a354fce..5c5e407b 100644 --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -82,14 +82,25 @@ data GlobResult = GlobResult { expandGlobs :: String -> FilePath -> [String] -> IO ([String], [FilePath]) expandGlobs name dir patterns = do files <- globDir compiledPatterns dir >>= mapM removeDirectories + badFiles <- globDir compiledExcludes dir >>= mapM removeDirectories let + results :: [GlobResult] results = map (uncurry $ uncurry GlobResult) $ zip (zip patterns compiledPatterns) (map sort files) - return (combineResults results) - where - combineResults :: [GlobResult] -> ([String], [FilePath]) - combineResults = bimap concat (nub . concat) . unzip . map fromResult - + exclusions :: [GlobResult] + exclusions = map (uncurry $ uncurry GlobResult) $ zip (zip patterns compiledExcludes) (map sort badFiles) + return (combineResults results exclusions) + where + combineResults :: [GlobResult] -> [GlobResult] -> ([String], [FilePath]) + combineResults inc exc = + let + + (inwarn, include) = convertResults inc + (exwarn, exclude) = convertResults exc + in + (inwarn ++ exwarn, include \\ exclude) + convertResults :: [GlobResult] -> ([String], [FilePath]) + convertResults = bimap concat (nub . concat) . unzip . map fromResult fromResult :: GlobResult -> ([String], [FilePath]) fromResult (GlobResult pattern compiledPattern files) = case files of [] -> (warning, literalFile) @@ -107,10 +118,16 @@ expandGlobs name dir patterns = do warn pattern compiledPattern | isLiteral compiledPattern = "Specified file " ++ show pattern ++ " for " ++ name ++ " does not exist" | otherwise = "Specified pattern " ++ show pattern ++ " for " ++ name ++ " does not match any files" - compiledPatterns :: [Pattern] - compiledPatterns = map (compileWith options) patterns - + compiledPatterns = map fst $ filter (not . snd) compiledGlobs + compiledExcludes :: [Pattern] + compiledExcludes = map fst $ filter snd compiledGlobs + compiledGlobs :: [(Pattern, Bool)] + compiledGlobs = map compileHelper patterns + + compileHelper :: String -> (Pattern, Bool) + compileHelper ('!':pattern) = (compileWith options pattern, True) + compileHelper pattern = (compileWith options pattern, False) removeDirectories :: [FilePath] -> IO [FilePath] removeDirectories = filterM doesFileExist diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs index 19b0ba94..0a225466 100644 --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -621,7 +621,20 @@ spec = around_ (inTempDirectoryNamed "foo") $ do CHANGES.markdown README.markdown |]) {packageCabalVersion = "1.18"} - + it "accepts exclusion patterns" $ do + touch "CHANGES.markdown" + touch "README.markdown" + touch "LICENSE.markdown" + [i| + extra-doc-files: + - "*.markdown" + - "!LICENSE.markdown" + |] `shouldRenderTo` (package [i| + extra-doc-files: + CHANGES.markdown + README.markdown + |]) {packageCabalVersion = "1.18"} + it "warns if a glob pattern does not match anything" $ do [i| name: foo @@ -1090,7 +1103,17 @@ spec = around_ (inTempDirectoryNamed "foo") $ do cbits/baz.c cbits/foo.c |] - + it "accepts exclusion patterns" $ do + [i| + library: + c-sources: + - cbits/*.c + - "!cbits/foo.c" + |] `shouldRenderTo` library_ [i| + c-sources: + cbits/bar.c + cbits/baz.c + |] it "warns when a glob pattern does not match any files" $ do [i| name: foo diff --git a/test/Hpack/UtilSpec.hs b/test/Hpack/UtilSpec.hs index 32cd7af6..a90d5a66 100644 --- a/test/Hpack/UtilSpec.hs +++ b/test/Hpack/UtilSpec.hs @@ -49,7 +49,7 @@ spec = do touch (dir "foo.js") touch (dir "bar.js") expandGlobs "field-name" dir ["foo.js", "bar.js"] `shouldReturn` ([], ["foo.js", "bar.js"]) - + it "removes duplicates" $ \dir -> do touch (dir "foo.js") expandGlobs "field-name" dir ["foo.js", "*.js"] `shouldReturn` ([], ["foo.js"]) @@ -64,7 +64,19 @@ spec = do touch (dir "foo2") touch (dir "foo[1,2]") expandGlobs "field-name" dir ["foo[1,2]"] `shouldReturn` ([], ["foo[1,2]"]) - + context "when accepting exclusion patterns" $ do + it "removes all files matched" $ \dir -> do + let goodfiles = [ + "files/foo.js" + , "files/bar.js" + , "files/baz.js"] + badfiles = [ + "files/foo.hs" + , "files/bar.hs" + , "files/baz.hs"] + mapM_ (touch . (dir )) goodfiles + mapM_ (touch . (dir )) badfiles + expandGlobs "field-name" dir ["files/*", "!files/*.hs"] `shouldReturn` ([], sort goodfiles) context "when expanding *" $ do it "expands by extension" $ \dir -> do let files = [