Generalizing info extraction from Cabal.

CabalApi.hs

@@ -1,7 +1,8 @@
 module CabalApi (
-  cabalParseFile,
-  cabalBuildInfo,
-  cabalDependPackages
+    cabalParseFile
+  , cabalBuildInfo
+  , cabalDependPackages
+  , getBuildInfos
   ) where
 
 import Control.Applicative
@@ -9,20 +10,18 @@ import Control.Applicative
 import Data.Maybe (fromJust, maybeToList)
 import Data.Set (fromList, toList)
 
-import Distribution.Verbosity (silent)
 import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
 import Distribution.PackageDescription
-  (GenericPackageDescription,
-   condLibrary, condExecutables, condTestSuites, condBenchmarks,
-   BuildInfo, libBuildInfo, buildInfo,
-   CondTree, condTreeConstraints, condTreeData)
 import Distribution.PackageDescription.Parse (readPackageDescription)
+import Distribution.Verbosity (silent)
 
 ----------------------------------------------------------------
 
 cabalParseFile :: FilePath -> IO GenericPackageDescription
 cabalParseFile = readPackageDescription silent
 
+----------------------------------------------------------------
+
 -- Causes error, catched in the upper function.
 cabalBuildInfo :: GenericPackageDescription -> BuildInfo
 cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
@@ -32,23 +31,45 @@ cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
     toMaybe []    = Nothing
     toMaybe (x:_) = Just x
 
-getDepsOfPairs :: [(a1, CondTree v [b] a)] -> [b]
-getDepsOfPairs =  concatMap (condTreeConstraints . snd)
+----------------------------------------------------------------
+
+cabalDependPackages :: GenericPackageDescription -> [String]
+cabalDependPackages = uniqueAndSort . map getDependencyPackageName . allDependsOfDescription
+  where
+    uniqueAndSort = toList . fromList
 
 allDependsOfDescription :: GenericPackageDescription -> [Dependency]
-allDependsOfDescription pd =
-  concat [depLib, depExe, depTests, depBench]
+allDependsOfDescription = fromPackageDescription getDeps getDeps getDeps getDeps
   where
-    depLib   = concatMap condTreeConstraints (maybeToList . condLibrary $ pd)
-    depExe   = getDepsOfPairs . condExecutables $ pd
-    depTests = getDepsOfPairs . condTestSuites  $ pd
-    depBench = getDepsOfPairs . condBenchmarks  $ pd
+    getDeps :: [Tree a] -> [Dependency]
+    getDeps = concatMap condTreeConstraints
 
 getDependencyPackageName :: Dependency -> String
 getDependencyPackageName (Dependency (PackageName n) _) = n
 
-cabalDependPackages :: GenericPackageDescription -> [String]
-cabalDependPackages =
-  toList . fromList
-  . map getDependencyPackageName
-  . allDependsOfDescription
+----------------------------------------------------------------
+
+getBuildInfos :: GenericPackageDescription -> [BuildInfo]
+getBuildInfos = fromPackageDescription f1 f2 f3 f4
+  where
+    f1 = map (libBuildInfo       . condTreeData)
+    f2 = map (buildInfo          . condTreeData)
+    f3 = map (testBuildInfo      . condTreeData)
+    f4 = map (benchmarkBuildInfo . condTreeData)
+
+----------------------------------------------------------------
+
+type Tree = CondTree ConfVar [Dependency]
+
+fromPackageDescription :: ([Tree Library]    -> [a])
+                       -> ([Tree Executable] -> [a])
+                       -> ([Tree TestSuite]  -> [a])
+                       -> ([Tree Benchmark]  -> [a])
+                       -> GenericPackageDescription
+                       -> [a]
+fromPackageDescription f1 f2 f3 f4 pd = lib ++ exe ++ tests ++ bench
+  where
+    lib   = f1 . maybeToList . condLibrary $ pd
+    exe   = f2 . map snd . condExecutables $ pd
+    tests = f3 . map snd . condTestSuites  $ pd
+    bench = f4 . map snd . condBenchmarks  $ pd