Allow Exclusion globs

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
 

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

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 = [