From 7751f6d476561192d9607c20011dc9c1b576369f Mon Sep 17 00:00:00 2001 From: BulbyVR <26726264+TheDrawingCoder-Gamer@users.noreply.github.com> Date: Sun, 8 May 2022 16:41:13 -0400 Subject: [PATCH 1/3] Add exclusions --- src/Hpack/Util.hs | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs index 9a354fce..9a259e44 100644 --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -82,14 +82,26 @@ 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 + include :: [(String, FilePath)] + include = uncurry zip $ convertResults inc + exclude :: [(String, FilePath)] + exclude = uncurry zip $ convertResults exc + in + unzip $ union include exclude \\ intersect 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 +119,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 From f20f4269674341a8fb692a571f5f0fe568006150 Mon Sep 17 00:00:00 2001 From: BulbyVR <26726264+TheDrawingCoder-Gamer@users.noreply.github.com> Date: Sun, 8 May 2022 17:12:34 -0400 Subject: [PATCH 2/3] Symmetric difference is incorrect, use difference --- src/Hpack/Util.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs index 9a259e44..5c5e407b 100644 --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -94,12 +94,11 @@ expandGlobs name dir patterns = do combineResults :: [GlobResult] -> [GlobResult] -> ([String], [FilePath]) combineResults inc exc = let - include :: [(String, FilePath)] - include = uncurry zip $ convertResults inc - exclude :: [(String, FilePath)] - exclude = uncurry zip $ convertResults exc + + (inwarn, include) = convertResults inc + (exwarn, exclude) = convertResults exc in - unzip $ union include exclude \\ intersect include exclude + (inwarn ++ exwarn, include \\ exclude) convertResults :: [GlobResult] -> ([String], [FilePath]) convertResults = bimap concat (nub . concat) . unzip . map fromResult fromResult :: GlobResult -> ([String], [FilePath]) From 7b695a31dcfa5b6df9065e1ec695b0e16ed2602d Mon Sep 17 00:00:00 2001 From: BulbyVR <26726264+TheDrawingCoder-Gamer@users.noreply.github.com> Date: Sun, 8 May 2022 18:00:40 -0400 Subject: [PATCH 3/3] Add tests --- test/EndToEndSpec.hs | 27 +++++++++++++++++++++++++-- test/Hpack/UtilSpec.hs | 16 ++++++++++++++-- 2 files changed, 39 insertions(+), 4 deletions(-) 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 = [