Merge pull request #123 from mitchellwrosen/master

Support globs in c-sources

src/Hpack/Config.hs

@@ -464,25 +464,27 @@ mkPackage :: FilePath -> (CaptureUnknownFields (Section PackageConfig)) -> IO ([
 mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionData = PackageConfig{..}}) = do
   let name = fromMaybe (takeBaseName dir) packageConfigName
 
-  mLibrary <- mapM (toLibrary dir name globalOptions) mLibrarySection
-  executables <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) executableSections)
-  tests <- toExecutables dir globalOptions (map (fmap captureUnknownFieldsValue) testsSections)
-  benchmarks <- toExecutables dir globalOptions  (map (fmap captureUnknownFieldsValue) benchmarkSections)
+  (globalCSourcesWarnings, globalOptions') <- globSectionCSources dir globalOptions
+
+  mLibrary <- mapM (toLibrary dir name globalOptions') mLibrarySection
+  (executablesCSourcesWarnings, executables) <- toExecutables dir globalOptions' (map (fmap captureUnknownFieldsValue) executableSections)
+  (testsCSourcesWarnings, tests) <- toExecutables dir globalOptions' (map (fmap captureUnknownFieldsValue) testsSections)
+  (benchmarksCSourcesWarnings, benchmarks) <- toExecutables dir globalOptions'  (map (fmap captureUnknownFieldsValue) benchmarkSections)
 
   licenseFileExists <- doesFileExist (dir </> "LICENSE")
 
   missingSourceDirs <- nub . sort <$> filterM (fmap not <$> doesDirectoryExist . (dir </>)) (
-       maybe [] sectionSourceDirs mLibrary
+       maybe [] sectionSourceDirs (fmap snd mLibrary)
     ++ concatMap sectionSourceDirs executables
     ++ concatMap sectionSourceDirs tests
     ++ concatMap sectionSourceDirs benchmarks
     )
 
   (extraSourceFilesWarnings, extraSourceFiles) <-
-    expandGlobs dir (fromMaybeList packageConfigExtraSourceFiles)
+    expandGlobs "extra-source-files" dir (fromMaybeList packageConfigExtraSourceFiles)
 
   (dataFilesWarnings, dataFiles) <-
-    expandGlobs dir (fromMaybeList packageConfigDataFiles)
+    expandGlobs "data-files" dir (fromMaybeList packageConfigDataFiles)
 
   let pkg = Package {
         packageName = name
@@ -504,7 +506,7 @@ mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionD
       , packageExtraSourceFiles = extraSourceFiles
       , packageDataFiles = dataFiles
       , packageSourceRepository = sourceRepository
-      , packageLibrary = mLibrary
+      , packageLibrary = fmap snd mLibrary
       , packageExecutables = executables
       , packageTests = tests
       , packageBenchmarks = benchmarks
@@ -517,6 +519,11 @@ mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionD
         ++ formatUnknownSectionFields "executable" executableSections
         ++ formatUnknownSectionFields "test" testsSections
         ++ formatMissingSourceDirs missingSourceDirs
+        ++ globalCSourcesWarnings
+        ++ fromMaybe [] (fmap fst mLibrary)
+        ++ executablesCSourcesWarnings
+        ++ testsCSourcesWarnings
+        ++ benchmarksCSourcesWarnings
         ++ extraSourceFilesWarnings
         ++ dataFilesWarnings
 
@@ -587,12 +594,23 @@ mkPackage dir (CaptureUnknownFields unknownFields globalOptions@Section{sectionD
       where
         fromGithub = (++ "/issues") . sourceRepositoryUrl <$> github
 
-toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO (Section Library)
-toLibrary dir name globalOptions library = traverse fromLibrarySection sect
-  where
-    sect :: Section LibrarySection
-    sect = mergeSections globalOptions library
+-- | Expand the @c-sources@ globs in a 'Section' and return the modified
+-- 'Section' along with any warnings emitted.
+globSectionCSources :: FilePath -> Section a -> IO ([String], Section a)
+globSectionCSources dir sect = do
+  (cSourcesWarnings, cSourcesFiles) <-
+    expandGlobs "c-sources" dir (sectionCSources sect)
+  return (cSourcesWarnings, sect {sectionCSources = cSourcesFiles})
 
+toLibrary :: FilePath -> String -> Section global -> Section LibrarySection -> IO ([String], Section Library)
+toLibrary dir name globalOptions librarySection = do
+  (cSourcesWarnings, librarySection') <- globSectionCSources dir librarySection
+  library <- toLibrary' dir name (mergeSections globalOptions librarySection')
+  return (cSourcesWarnings, library)
+
+toLibrary' :: FilePath -> String -> Section LibrarySection -> IO (Section Library)
+toLibrary' dir name sect = traverse fromLibrarySection sect
+  where
     sourceDirs :: [FilePath]
     sourceDirs = sectionSourceDirs sect
 
@@ -603,26 +621,31 @@ toLibrary dir name globalOptions library = traverse fromLibrarySection sect
           reexportedModules = fromMaybeList librarySectionReexportedModules
       return (Library librarySectionExposed exposedModules otherModules reexportedModules)
 
-toExecutables :: FilePath -> Section global -> [(String, Section ExecutableSection)] -> IO [Section Executable]
-toExecutables dir globalOptions executables = mapM toExecutable sections
+toExecutables :: FilePath -> Section global -> [(String, Section ExecutableSection)] -> IO ([String], [Section Executable])
+toExecutables dir globalOptions executableSections = do
+  (warnings, executables) <- unzip <$> mapM (toExecutable dir globalOptions) executableSections
+  return (concat warnings, executables)
+
+toExecutable :: FilePath -> Section global -> (String, Section ExecutableSection) -> IO ([String], Section Executable)
+toExecutable dir globalOptions (name, executableSection) = do
+  (cSourcesWarnings, executableSection') <- globSectionCSources dir executableSection
+  executable <- toExecutable' dir name (mergeSections globalOptions executableSection')
+  return (cSourcesWarnings, executable)
+
+toExecutable' :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable)
+toExecutable' dir name sect@Section{..} = do
+  (executable, ghcOptions) <- fromExecutableSection sectionData
+  return (sect {sectionData = executable, sectionGhcOptions = sectionGhcOptions ++ ghcOptions})
   where
-    sections :: [(String, Section ExecutableSection)]
-    sections = map (fmap $ mergeSections globalOptions) executables
-
-    toExecutable :: (String, Section ExecutableSection) -> IO (Section Executable)
-    toExecutable (name, sect@Section{..}) = do
-      (executable, ghcOptions) <- fromExecutableSection sectionData
-      return (sect {sectionData = executable, sectionGhcOptions = sectionGhcOptions ++ ghcOptions})
+    fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption])
+    fromExecutableSection ExecutableSection{..} = do
+      modules <- maybe (filterMain . concat <$> mapM (getModules dir) sectionSourceDirs) (return . fromList) executableSectionOtherModules
+      return (Executable name mainSrcFile modules, ghcOptions)
       where
-        fromExecutableSection :: ExecutableSection -> IO (Executable, [GhcOption])
-        fromExecutableSection ExecutableSection{..} = do
-          modules <- maybe (filterMain . concat <$> mapM (getModules dir) sectionSourceDirs) (return . fromList) executableSectionOtherModules
-          return (Executable name mainSrcFile modules, ghcOptions)
-          where
-            filterMain :: [String] -> [String]
-            filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain)
+        filterMain :: [String] -> [String]
+        filterMain = maybe id (filter . (/=)) (toModule $ splitDirectories executableSectionMain)
 
-            (mainSrcFile, ghcOptions) = parseMain executableSectionMain
+        (mainSrcFile, ghcOptions) = parseMain executableSectionMain
 
 mergeSections :: Section global -> Section a -> Section a
 mergeSections globalOptions options

src/Hpack/Util.hs

@@ -101,14 +101,14 @@ tryReadFile file = do
 toPosixFilePath :: FilePath -> FilePath
 toPosixFilePath = Posix.joinPath . splitDirectories
 
-expandGlobs :: FilePath -> [String] -> IO ([String], [FilePath])
-expandGlobs dir patterns = do
+expandGlobs :: String -> FilePath -> [String] -> IO ([String], [FilePath])
+expandGlobs name dir patterns = do
   files <- (fst <$> globDir compiledPatterns dir) >>= mapM removeDirectories
   let warnings = [warn pattern | ([], pattern) <- zip files patterns]
   return (warnings, combineResults files)
   where
     combineResults = nub . sort . map (toPosixFilePath . makeRelative dir) . concat
-    warn pattern = "Specified pattern " ++ show pattern ++ " for extra-source-files does not match any files"
+    warn pattern = "Specified pattern " ++ show pattern ++ " for " ++ name ++ " does not match any files"
     compiledPatterns = map (compileWith options) patterns
     removeDirectories = filterM doesFileExist
     options = CompOptions {

test/Hpack/ConfigSpec.hs

@@ -112,10 +112,10 @@ spec = do
         let input = [i|
               c-sources:
                 - foo.c
-                - bar.c
+                - bar/*.c
               |]
         captureUnknownFieldsValue <$> decodeEither input
-          `shouldBe` Right (section Empty){sectionCSources = ["foo.c", "bar.c"]}
+          `shouldBe` Right (section Empty){sectionCSources = ["foo.c", "bar/*.c"]}
 
       it "accepts extra-lib-dirs" $ do
         let input = [i|
@@ -690,6 +690,30 @@ spec = do
           |]
           (packageLibrary >>> (`shouldBe` Just (section library) {sectionBuildTools = ["alex", "happy"]}))
 
+      it "accepts c-sources" $ do
+        withPackageConfig [i|
+          library:
+            c-sources:
+              - cbits/*.c
+          |]
+          (do
+          touch "cbits/foo.c"
+          touch "cbits/bar.c"
+          )
+          (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}))
+
+      it "accepts global c-sources" $ do
+        withPackageConfig [i|
+          c-sources:
+            - cbits/*.c
+          library: {}
+          |]
+          (do
+          touch "cbits/foo.c"
+          touch "cbits/bar.c"
+          )
+          (packageLibrary >>> (`shouldBe` Just (section library) {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}))
+
       it "allows to specify exposed" $ do
         withPackageConfig_ [i|
           library:
@@ -915,6 +939,33 @@ spec = do
           |]
           (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionGhcProfOptions = ["-fprof-auto"]}]})
 
+      it "accepts c-sources" $ do
+        withPackageConfig [i|
+          executables:
+            foo:
+              main: driver/Main.hs
+              c-sources:
+                - cbits/*.c
+          |]
+          (do
+          touch "cbits/foo.c"
+          touch "cbits/bar.c"
+          )
+          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]})
+
+      it "accepts global c-sources" $ do
+        withPackageConfig [i|
+          c-sources:
+            - cbits/*.c
+          executables:
+            foo:
+              main: driver/Main.hs
+          |]
+          (do
+          touch "cbits/foo.c"
+          touch "cbits/bar.c"
+          )
+          (`shouldBe` package {packageExecutables = [(section $ executable "foo" "driver/Main.hs") {sectionCSources = ["cbits/bar.c", "cbits/foo.c"]}]})
 
     context "when reading test section" $ do
       it "warns on unknown fields" $ do

test/Hpack/UtilSpec.hs

@@ -97,22 +97,22 @@ spec = do
   describe "expandGlobs" $ around withTempDirectory $ do
     it "accepts simple files" $ \dir -> do
         touch (dir </> "foo.js")
-        expandGlobs dir ["foo.js"] `shouldReturn` ([], ["foo.js"])
+        expandGlobs "" dir ["foo.js"] `shouldReturn` ([], ["foo.js"])
 
     it "removes duplicates" $ \dir -> do
       touch (dir </> "foo.js")
-      expandGlobs dir ["foo.js", "*.js"] `shouldReturn` ([], ["foo.js"])
+      expandGlobs "" dir ["foo.js", "*.js"] `shouldReturn` ([], ["foo.js"])
 
     it "rejects directories" $ \dir -> do
       touch (dir </> "foo")
       createDirectory (dir </> "bar")
-      expandGlobs dir ["*"] `shouldReturn` ([], ["foo"])
+      expandGlobs "" dir ["*"] `shouldReturn` ([], ["foo"])
 
     it "rejects character ranges" $ \dir -> do
       touch (dir </> "foo1")
       touch (dir </> "foo2")
       touch (dir </> "foo[1,2]")
-      expandGlobs dir ["foo[1,2]"] `shouldReturn` ([], ["foo[1,2]"])
+      expandGlobs "" dir ["foo[1,2]"] `shouldReturn` ([], ["foo[1,2]"])
 
     context "when expanding *" $ do
       it "expands by extension" $ \dir -> do
@@ -122,36 +122,36 @@ spec = do
               , "files/baz.js"]
         mapM_ (touch . (dir </>)) files
         touch (dir </> "files/foo.hs")
-        expandGlobs dir ["files/*.js"] `shouldReturn` ([], sort files)
+        expandGlobs "" dir ["files/*.js"] `shouldReturn` ([], sort files)
 
       it "rejects dot-files" $ \dir -> do
         touch (dir </> "foo/bar")
         touch (dir </> "foo/.baz")
-        expandGlobs dir ["foo/*"] `shouldReturn` ([], ["foo/bar"])
+        expandGlobs "" dir ["foo/*"] `shouldReturn` ([], ["foo/bar"])
 
       it "accepts dot-files when explicitly asked to" $ \dir -> do
         touch (dir </> "foo/bar")
         touch (dir </> "foo/.baz")
-        expandGlobs dir ["foo/.*"] `shouldReturn` ([], ["foo/.baz"])
+        expandGlobs "" dir ["foo/.*"] `shouldReturn` ([], ["foo/.baz"])
 
       it "matches at most one directory component" $ \dir -> do
         touch (dir </> "foo/bar/baz.js")
         touch (dir </> "foo/bar.js")
-        expandGlobs dir ["*/*.js"] `shouldReturn` ([], ["foo/bar.js"])
+        expandGlobs "" dir ["*/*.js"] `shouldReturn` ([], ["foo/bar.js"])
 
     context "when expanding **" $ do
       it "matches arbitrary many directory components" $ \dir -> do
         let file = "foo/bar/baz.js"
         touch (dir </> file)
-        expandGlobs dir ["**/*.js"] `shouldReturn` ([], [file])
+        expandGlobs "" dir ["**/*.js"] `shouldReturn` ([], [file])
 
     context "when a pattern does not match anything" $ do
       it "warns" $ \dir -> do
-        expandGlobs dir ["foo"] `shouldReturn`
-          (["Specified pattern \"foo\" for extra-source-files does not match any files"], [])
+        expandGlobs "XXX" dir ["foo"] `shouldReturn`
+          (["Specified pattern \"foo\" for XXX does not match any files"], [])
 
     context "when a pattern only matches a directory" $ do
       it "warns" $ \dir -> do
         createDirectory (dir </> "foo")
-        expandGlobs dir ["foo"] `shouldReturn`
-          (["Specified pattern \"foo\" for extra-source-files does not match any files"], [])
+        expandGlobs "XXX" dir ["foo"] `shouldReturn`
+          (["Specified pattern \"foo\" for XXX does not match any files"], [])