Generalizing info extraction from Cabal.

This commit is contained in:
Kazu Yamamoto 2013-03-01 14:40:34 +09:00
parent a8e57615ba
commit 561bb38900

View File

@ -1,7 +1,8 @@
module CabalApi ( module CabalApi (
cabalParseFile, cabalParseFile
cabalBuildInfo, , cabalBuildInfo
cabalDependPackages , cabalDependPackages
, getBuildInfos
) where ) where
import Control.Applicative import Control.Applicative
@ -9,19 +10,17 @@ import Control.Applicative
import Data.Maybe (fromJust, maybeToList) import Data.Maybe (fromJust, maybeToList)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import Distribution.Verbosity (silent)
import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
import Distribution.PackageDescription import Distribution.PackageDescription
(GenericPackageDescription,
condLibrary, condExecutables, condTestSuites, condBenchmarks,
BuildInfo, libBuildInfo, buildInfo,
CondTree, condTreeConstraints, condTreeData)
import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Verbosity (silent)
---------------------------------------------------------------- ----------------------------------------------------------------
cabalParseFile :: FilePath -> IO GenericPackageDescription cabalParseFile :: FilePath -> IO GenericPackageDescription
cabalParseFile = readPackageDescription silent cabalParseFile = readPackageDescription silent
----------------------------------------------------------------
-- Causes error, catched in the upper function. -- Causes error, catched in the upper function.
cabalBuildInfo :: GenericPackageDescription -> BuildInfo cabalBuildInfo :: GenericPackageDescription -> BuildInfo
@ -29,26 +28,48 @@ cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
where where
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c) fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)
toMaybe [] = Nothing toMaybe [] = Nothing
toMaybe (x:_) = Just x 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 :: GenericPackageDescription -> [Dependency]
allDependsOfDescription pd = allDependsOfDescription = fromPackageDescription getDeps getDeps getDeps getDeps
concat [depLib, depExe, depTests, depBench]
where where
depLib = concatMap condTreeConstraints (maybeToList . condLibrary $ pd) getDeps :: [Tree a] -> [Dependency]
depExe = getDepsOfPairs . condExecutables $ pd getDeps = concatMap condTreeConstraints
depTests = getDepsOfPairs . condTestSuites $ pd
depBench = getDepsOfPairs . condBenchmarks $ pd
getDependencyPackageName :: Dependency -> String getDependencyPackageName :: Dependency -> String
getDependencyPackageName (Dependency (PackageName n) _) = n getDependencyPackageName (Dependency (PackageName n) _) = n
cabalDependPackages :: GenericPackageDescription -> [String] ----------------------------------------------------------------
cabalDependPackages =
toList . fromList getBuildInfos :: GenericPackageDescription -> [BuildInfo]
. map getDependencyPackageName getBuildInfos = fromPackageDescription f1 f2 f3 f4
. allDependsOfDescription 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