mirror of
https://github.com/sol/hpack.git
synced 2024-10-04 03:38:00 +03:00
Do not infer Setup when source dir is "." (addresses #37)
This commit is contained in:
parent
5ea133a225
commit
fe947153ba
@ -19,6 +19,9 @@ module Hpack.Config (
|
||||
, Library(..)
|
||||
, Executable(..)
|
||||
, SourceRepository(..)
|
||||
|
||||
-- exported for testing
|
||||
, getModules
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
@ -436,14 +439,22 @@ determineModules modules mExposedModules mOtherModules = case (mExposedModules,
|
||||
exposedModules = maybe (modules \\ otherModules) fromList mExposedModules
|
||||
|
||||
getModules :: FilePath -> IO [String]
|
||||
getModules src = sort <$> do
|
||||
exits <- doesDirectoryExist src
|
||||
if exits
|
||||
then toModules <$> getFilesRecursive src
|
||||
getModules src_ = sort <$> do
|
||||
exists <- doesDirectoryExist src_
|
||||
if exists
|
||||
then do
|
||||
src <- canonicalizePath src_
|
||||
cwd <- getCurrentDirectory
|
||||
removeSetup cwd src . toModules <$> getFilesRecursive src
|
||||
else return []
|
||||
where
|
||||
toModules :: [[FilePath]] -> [String]
|
||||
toModules = catMaybes . map toModule
|
||||
|
||||
removeSetup :: FilePath -> FilePath -> [String] -> [String]
|
||||
removeSetup cwd src
|
||||
| src == cwd = filter (/= "Setup")
|
||||
| otherwise = id
|
||||
|
||||
fromMaybeList :: Maybe (List a) -> [a]
|
||||
fromMaybeList = maybe [] fromList
|
||||
|
@ -78,6 +78,25 @@ spec = do
|
||||
}|]
|
||||
parseEither parseJSON value `shouldBe` (Left "neither key \"git\" nor key \"github\" present" :: Either String Dependency)
|
||||
|
||||
describe "getModules" $ around_ inTempDirectory $ do
|
||||
it "returns Haskell modules in specified source directory" $ do
|
||||
touch "src/Foo.hs"
|
||||
touch "src/Bar/Baz.hs"
|
||||
touch "src/Setup.hs"
|
||||
getModules "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"])
|
||||
|
||||
context "when source directory is '.'" $ do
|
||||
it "ignores Setup" $ do
|
||||
touch "Foo.hs"
|
||||
touch "Setup.hs"
|
||||
getModules "." `shouldReturn` ["Foo"]
|
||||
|
||||
context "when source directory is './.'" $ do
|
||||
it "ignores Setup" $ do
|
||||
touch "Foo.hs"
|
||||
touch "Setup.hs"
|
||||
getModules "./." `shouldReturn` ["Foo"]
|
||||
|
||||
describe "readPackageConfig" $ around_ (inTempDirectoryNamed "foo") $ do
|
||||
it "warns on unknown fields" $ do
|
||||
writeFile "package.yaml" [i|
|
||||
|
Loading…
Reference in New Issue
Block a user