Add query to return build targets of a give cabal file and remove tests code.
Conflicts:
src/HSrcQuery.hs
diff --git a/haskell-src-query.cabal b/haskell-src-query.cabal
index 1b3719e..a72945c 100644
--- a/haskell-src-query.cabal
+++ b/haskell-src-query.cabal
@@ -23,3 +23,12 @@
optparse-applicative >= 0.7.0.2,
syb >= 0.4.1
+test-suite spec
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ ghc-options: -Wall
+ hs-source-dirs: src, test
+ build-depends: base >= 4 && < 5,
+ Cabal >= 1.18.0,
+ hspec >= 1.8.1,
+ mtl >= 2.1.2
diff --git a/src/Cabal.hs b/src/Cabal.hs
index b7c7e7b..7c3ecd0 100644
--- a/src/Cabal.hs
+++ b/src/Cabal.hs
@@ -1,8 +1,13 @@
{-# LANGUAGE RecordWildCards #-}
-module Cabal (buildTargetSrcDirs) where
+module Cabal ( buildTargetSrcDirs
+ , buildTargetNames'
+ , findSrcDirs
+ ) where
+import Control.Applicative
import Data.List
+import Data.Monoid
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
@@ -13,24 +18,30 @@
type Cond a = (BuildTargetName, CondTree ConfVar [Dependency] a)
------------------------------------------------------------------------------
-buildTargetSrcDirs :: FilePath -> BuildTargetName -> IO (Maybe [SrcDirs])
+buildTargetNames' :: GenericPackageDescription -> [String]
+buildTargetNames' GenericPackageDescription{..} = (fst <$> condExecutables)
+ <> (fst <$> condTestSuites)
+ <> (fst <$> condBenchmarks)
+
+------------------------------------------------------------------------------
+buildTargetSrcDirs :: FilePath -> BuildTargetName -> IO [SrcDirs]
buildTargetSrcDirs cabalFilePath btn = do
gPDesc <- readPackageDescription silent cabalFilePath
return $ findSrcDirs gPDesc btn
------------------------------------------------------------------------------
-findSrcDirs :: GenericPackageDescription -> BuildTargetName -> Maybe [SrcDirs]
+findSrcDirs :: GenericPackageDescription -> BuildTargetName -> [SrcDirs]
findSrcDirs GenericPackageDescription{..} btn =
case findTarget btn condExecutables of
- Just execTarget -> Just . hsSourceDirs . buildInfo $ execTarget
+ Just execTarget -> hsSourceDirs . buildInfo $ execTarget
Nothing -> case findTarget btn condTestSuites of
- Just testTarget -> Just . hsSourceDirs . testBuildInfo $ testTarget
+ Just testTarget -> hsSourceDirs . testBuildInfo $ testTarget
Nothing -> case findTarget btn condBenchmarks of
- Just benchmarkTarget -> Just . hsSourceDirs . benchmarkBuildInfo $ benchmarkTarget
- Nothing -> Nothing
+ Just benchmarkTarget -> hsSourceDirs . benchmarkBuildInfo $ benchmarkTarget
+ Nothing -> []
------------------------------------------------------------------------------
-findTarget :: BuildTargetName -> [(Cond a)] -> Maybe a
+findTarget :: BuildTargetName -> [Cond a] -> Maybe a
findTarget btn targets = do
(_, CondNode a _ _ ) <- find isBuildTarget targets
return a
diff --git a/src/HDevTools.hs b/src/HDevTools.hs
index 012adde..561c7bb 100644
--- a/src/HDevTools.hs
+++ b/src/HDevTools.hs
@@ -19,22 +19,16 @@
where
search = do
let packageConfigOption = ghcOptionPkgConfig pkgConfigPath
- maybeOptionSrcDirs <- ghcOptionSrcDirs cabalFilePath buildTargetName
- case maybeOptionSrcDirs of
- Just optionSrcDirs -> do
- let args = ["info", filePath, symName, packageConfigOption] ++ optionSrcDirs
- readProcessWithExitCode hdevtools args ""
- Nothing -> readProcessWithExitCode hdevtools ["info", filePath, symName, packageConfigOption] ""
-
+ srcDirs <- ghcOptionSrcDirs cabalFilePath buildTargetName
+ let args = ["info", filePath, symName, packageConfigOption] ++ srcDirs
+ readProcessWithExitCode hdevtools args ""
+
------------------------------------------------------------------------------
-ghcOptionSrcDirs :: String -> String -> IO (Maybe [String])
+ghcOptionSrcDirs :: String -> String -> IO [String]
ghcOptionSrcDirs cabalFilePath buildTargetName = do
- maybeSrcDirs <- buildTargetSrcDirs cabalFilePath buildTargetName
- case maybeSrcDirs of
- Just srcDirs -> return $ Just $ map ghcOptionSrcDir srcDirs
- Nothing -> return $ Nothing
-
-
+ srcDirs <- buildTargetSrcDirs cabalFilePath buildTargetName
+ return $ map ghcOptionSrcDir srcDirs
+
------------------------------------------------------------------------------
hdevtools :: String
hdevtools = "hdevtools"
diff --git a/src/HSrcQuery.hs b/src/HSrcQuery.hs
index 045cb32..3c83837 100644
--- a/src/HSrcQuery.hs
+++ b/src/HSrcQuery.hs
@@ -4,6 +4,7 @@
import Options.Applicative
------------------------------------------------------------------------------
+import Cabal
import Client
import HLint
import Lambda
@@ -15,6 +16,7 @@
| LambdaArgs
| HLint
| ParseAST
+ | BuildTargets
deriving Show
------------------------------------------------------------------------------
@@ -77,6 +79,7 @@
| s == "lambdaArgs" = Just LambdaArgs
| s == "hlint" = Just HLint
| s == "parse" = Just ParseAST
+ | s == "targets" = Just BuildTargets
| otherwise = Nothing
------------------------------------------------------------------------------
@@ -104,10 +107,16 @@
cabalFilePath
buildTargetName
code
-runQuery LambdaBody _ _ _ _ code = return $ lambdaBody code
-runQuery LambdaArgs _ _ _ _ code = return $ lambdaArgs code
-runQuery HLint _ _ _ _ code = hlint code
-runQuery ParseAST _ _ _ _ code = return $ parseAST code
+runQuery LambdaBody _ _ _ _ code = return $ lambdaBody code
+runQuery LambdaArgs _ _ _ _ code = return $ lambdaArgs code
+runQuery HLint _ _ _ _ code = hlint code
+runQuery ParseAST _ _ _ _ code = return $ parseAST code
+runQuery BuildTargets _ _ cabaFilePath _ _ = targets cabaFilePath
+
------------------------------------------------------------------------------
-fn c = (\a b -> a + b) c
+targets :: FilePath -> IO String
+targets cabalFilePath = do
+ gpDesc <- readPackageDescription silent cabalFilePath
+ return . show . buildTargetNames' $ gpDesc
+
diff --git a/test/CabalSpec.hs b/test/CabalSpec.hs
new file mode 100644
index 0000000..796cf64
--- /dev/null
+++ b/test/CabalSpec.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE RecordWildCards #-}
+module CabalSpec (spec) where
+
+import Data.Monoid
+import Distribution.PackageDescription
+import Test.Hspec
+------------------------------------------------------------------------------
+import Cabal
+import Data.Cabal
+
+------------------------------------------------------------------------------
+spec :: Spec
+spec = describe "Cabal" $ do
+ it "can build a list of build target names" $ buildTargetNamesTest
+ it "can build a list of target source directories" $ buildTargetSrcDirsTest
+
+
+------------------------------------------------------------------------------
+buildTargetNamesTest :: Expectation
+buildTargetNamesTest = names `shouldContain` [ executableBuildTargetName
+ , testSuiteBuildTargetName
+ , benchmarkBuildTargetName
+ ]
+ where
+ names = buildTargetNames' cabalPackageWithTargets
+
+------------------------------------------------------------------------------
+buildTargetSrcDirsTest :: Expectation
+buildTargetSrcDirsTest = directories `shouldContain` sourceDirectories
+ where
+ directories = findSrcDirs cabalPackageWithSrcDirs
+ executableBuildTargetName
diff --git a/test/Data/Cabal.hs b/test/Data/Cabal.hs
new file mode 100644
index 0000000..2b07c21
--- /dev/null
+++ b/test/Data/Cabal.hs
@@ -0,0 +1,62 @@
+module Data.Cabal where
+
+import Data.Monoid
+import Distribution.Package
+import Distribution.PackageDescription
+
+
+------------------------------------------------------------------------------
+emptyGenericPackageDescription :: GenericPackageDescription
+emptyGenericPackageDescription =
+ GenericPackageDescription emptyPackageDescription
+ mempty
+ Nothing
+ mempty
+ mempty
+ mempty
+
+------------------------------------------------------------------------------
+cabalPackageWithTargets :: GenericPackageDescription
+cabalPackageWithTargets =
+ emptyGenericPackageDescription
+ { condExecutables = [(executableBuildTargetName, emptyCondTree)]
+ , condTestSuites = [(testSuiteBuildTargetName, emptyCondTree)]
+ , condBenchmarks = [(benchmarkBuildTargetName, emptyCondTree)]
+ }
+
+------------------------------------------------------------------------------
+emptyCondTree :: (Monoid c, Monoid a) => CondTree ConfVar c a
+emptyCondTree = CondNode mempty mempty mempty
+
+------------------------------------------------------------------------------
+cabalPackageWithSrcDirs =
+ emptyGenericPackageDescription
+ { condExecutables = [("executable", condTreeWithExecutable)] }
+
+------------------------------------------------------------------------------
+condTreeWithExecutable :: CondTree v [Dependency] Executable
+condTreeWithExecutable = CondNode executableWithBuildInfo mempty mempty
+
+------------------------------------------------------------------------------
+executableWithBuildInfo :: Executable
+executableWithBuildInfo = emptyExecutable { buildInfo = buildInfoWithSrcDirs }
+
+------------------------------------------------------------------------------
+buildInfoWithSrcDirs :: BuildInfo
+buildInfoWithSrcDirs = emptyBuildInfo { hsSourceDirs = sourceDirectories }
+
+------------------------------------------------------------------------------
+sourceDirectories :: [FilePath]
+sourceDirectories = ["path1", "path2"]
+
+------------------------------------------------------------------------------
+executableBuildTargetName :: [Char]
+executableBuildTargetName = "executable"
+
+------------------------------------------------------------------------------
+testSuiteBuildTargetName :: [Char]
+testSuiteBuildTargetName = "test-suite"
+
+------------------------------------------------------------------------------
+benchmarkBuildTargetName :: [Char]
+benchmarkBuildTargetName = "benchmark"
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}