module CabalCargs.BuildInfo
( BuildInfo(..)
, buildInfosOfLib
, buildInfosOfExe
, buildInfosOfTest
, buildInfosOfBenchmark
, buildInfosOf
, buildInfos
, field
) where
import qualified Distribution.PackageDescription as PD
import Distribution.PackageDescription (GenericPackageDescription(..), CondTree(..), ConfVar)
import Distribution.Compiler
import Distribution.Package (Dependency(..), PackageName(..))
import Distribution.Version (anyVersion)
import Language.Haskell.Extension
import Control.Lens
import Data.List (find)
import qualified CabalCargs.Sections as S
import qualified CabalCargs.Fields as F
import qualified CabalCargs.CondVars as CV
data BuildInfo = BuildInfo
{ buildInfo :: PD.BuildInfo
, buildDepends :: [Dependency]
} deriving (Show, Eq)
makeLensesFor [ ("buildInfo" , "buildInfoL")
, ("buildDepends", "buildDependsL")
] ''BuildInfo
makeLensesFor [ ("hsSourceDirs" , "hsSourceDirsL")
, ("options" , "optionsL")
, ("defaultLanguage" , "defaultLanguageL")
, ("cppOptions" , "cppOptionsL")
, ("cSources" , "cSourcesL")
, ("ccOptions" , "ccOptionsL")
, ("extraLibDirs" , "extraLibDirsL")
, ("extraLibs" , "extraLibsL")
, ("ldOptions" , "ldOptionsL")
, ("includeDirs" , "includeDirsL")
, ("includes" , "includesL")
] ''PD.BuildInfo
buildInfosOf :: S.Section -> CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOf S.Library = buildInfosOfLib
buildInfosOf (S.Executable name) = buildInfosOfExe name
buildInfosOf (S.TestSuite name) = buildInfosOfTest name
buildInfosOf (S.Benchmark name) = buildInfosOfBenchmark name
buildInfos :: CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfos vars pkgDescrp =
concat [ buildInfosOfLib vars pkgDescrp
, buildInfosOfAllExes vars pkgDescrp
, buildInfosOfAllTests vars pkgDescrp
, buildInfosOfAllBenchmarks vars pkgDescrp
]
buildInfosOfLib :: CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfLib vars pkgDescrp
| Just condLib <- condLibrary pkgDescrp
= map (toBuildInfo PD.libBuildInfo) $ condTreeDatasAndConstraints vars condLib
| otherwise
= []
buildInfosOfExe :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfExe name vars pkgDescrp
| Just (_, condExe) <- find ((== name) . fst) $ condExecutables pkgDescrp
= map (toBuildInfo PD.buildInfo) $ condTreeDatasAndConstraints vars condExe
| otherwise
= []
buildInfosOfAllExes :: CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfAllExes vars pkgDescrp =
concat $ map ((map (toBuildInfo PD.buildInfo)) . (condTreeDatasAndConstraints vars) . snd) (condExecutables pkgDescrp)
buildInfosOfTest :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfTest name vars pkgDescrp
| Just (_, condTest) <- find ((== name) . fst) $ condTestSuites pkgDescrp
= map (toBuildInfo PD.testBuildInfo) $ condTreeDatasAndConstraints vars condTest
| otherwise
= []
buildInfosOfAllTests :: CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfAllTests vars pkgDescrp =
concat $ map ((map (toBuildInfo PD.testBuildInfo)) . (condTreeDatasAndConstraints vars) . snd) (condTestSuites pkgDescrp)
buildInfosOfBenchmark :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfBenchmark name vars pkgDescrp
| Just (_, condBench) <- find ((== name) . fst) $ condBenchmarks pkgDescrp
= map (toBuildInfo PD.benchmarkBuildInfo) $ condTreeDatasAndConstraints vars condBench
| otherwise
= []
buildInfosOfAllBenchmarks :: CV.CondVars -> GenericPackageDescription -> [BuildInfo]
buildInfosOfAllBenchmarks vars pkgDescrp =
concat $ map ((map (toBuildInfo PD.benchmarkBuildInfo)) . (condTreeDatasAndConstraints vars) . snd) (condBenchmarks pkgDescrp)
toBuildInfo :: (dat -> PD.BuildInfo) -> (dat, [Dependency]) -> BuildInfo
toBuildInfo f (dat, deps) = BuildInfo { buildInfo = f dat
, buildDepends = deps
}
condTreeDatasAndConstraints :: CV.CondVars -> CondTree ConfVar [Dependency] dat -> [(dat, [Dependency])]
condTreeDatasAndConstraints vars tree = go (condTreeComponents tree) [dataAndConstraints tree]
where
go [] dats = dats
go ((cond, ifTree, elseTree) : comps) dats
| CV.eval vars cond
= go comps $ go (condTreeComponents ifTree) (dataAndConstraints ifTree : dats)
| Just tree <- elseTree
= go comps $ go (condTreeComponents tree) (dataAndConstraints tree : dats)
| otherwise
= go comps dats
dataAndConstraints tree = (condTreeData tree, condTreeConstraints tree)
field :: F.Field -> Traversal' BuildInfo [String]
field F.Hs_Source_Dirs = buildInfoL . hsSourceDirsL
field F.Ghc_Options = buildInfoL . optionsL . traversed . filtered ((== GHC) . fst) . _2
field F.Default_Extensions = buildInfoL . oldAndDefaultExtensionsL . extsToStrings
field F.Default_Language = buildInfoL . defaultLanguageL . langToString
field F.Cpp_Options = buildInfoL . cppOptionsL
field F.C_Sources = buildInfoL . cSourcesL
field F.Cc_Options = buildInfoL . ccOptionsL
field F.Extra_Lib_Dirs = buildInfoL . extraLibDirsL
field F.Extra_Libraries = buildInfoL . extraLibsL
field F.Ld_Options = buildInfoL . ldOptionsL
field F.Include_Dirs = buildInfoL . includeDirsL
field F.Includes = buildInfoL . includesL
field F.Build_Depends = buildDependsL . depsToStrings
field F.Package_Db = nopLens
field F.Autogen_Hs_Source_Dirs = nopLens
field F.Autogen_Include_Dirs = nopLens
field F.Autogen_Includes = nopLens
field F.Hdevtools_Socket = nopLens
oldAndDefaultExtensionsL :: Lens' PD.BuildInfo [Extension]
oldAndDefaultExtensionsL = lens getter setter
where
getter buildInfo = (PD.oldExtensions buildInfo) ++ (PD.defaultExtensions buildInfo)
setter buildInfo exts = buildInfo { PD.defaultExtensions = exts }
extsToStrings :: Iso' [Extension] [String]
extsToStrings = iso (map toString) (map toExt)
where
toString ext =
case ext of
EnableExtension knownExt -> show knownExt
DisableExtension knownExt -> "No" ++ show knownExt
UnknownExtension unknownExt -> unknownExt
toExt ('N':'o':rest)
| [(ext, _)] <- reads rest :: [(KnownExtension, String)]
= DisableExtension ext
toExt str
| [(ext, _)] <- reads str :: [(KnownExtension, String)]
= EnableExtension ext
| otherwise
= UnknownExtension str
langToString :: Iso' (Maybe Language) [String]
langToString = iso toString toLang
where
toString Nothing = []
toString (Just lang) =
case lang of
UnknownLanguage l -> [l]
_ -> [show lang]
toLang (str:[])
| [(lang, _)] <- reads str :: [(Language, String)]
= Just lang
| otherwise
= Just $ UnknownLanguage str
toLang _ = Nothing
depsToStrings :: Iso' [Dependency] [String]
depsToStrings = iso (map toString) (map toDep)
where
toString (Dependency (PackageName name) _) = name
toDep name = Dependency (PackageName name) anyVersion
nopLens :: Lens' BuildInfo [String]
nopLens = lens (const []) (\buildInfo _ -> buildInfo)