diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ If you want to call `hdevtools check` for a source file of a cabalized project and would like to consider all compiler relevant arguments in the cabal file - like `hs-source-dirs`, `ghc-options`, `cpp-options` ... - and also the `cabal sandbox`, -the you could just use `cabal-cargs` the following way: +then you could just use `cabal-cargs` the following way: $> hdevtools check `cabal-cargs --format=hdevtools --sourcefile=Source.hs` Source.hs diff --git a/cabal-cargs.cabal b/cabal-cargs.cabal --- a/cabal-cargs.cabal +++ b/cabal-cargs.cabal @@ -1,5 +1,5 @@ name: cabal-cargs -version: 0.1.1 +version: 0.2 cabal-version: >=1.9.2 build-type: Simple license: BSD3 @@ -41,7 +41,7 @@ Cabal >=1.18.0 && <1.19 exposed-modules: CabalCargs.Args CabalCargs.Field CabalCargs.Fields CabalCargs.Formatting CabalCargs.Format CabalCargs.Spec - CabalCargs.Sections CabalCargs.CompilerArgs CabalCargs.Lenses + CabalCargs.Sections CabalCargs.CompilerArgs CabalCargs.BuildInfo CabalCargs.CondVars exposed: True buildable: True diff --git a/lib/CabalCargs/Args.hs b/lib/CabalCargs/Args.hs --- a/lib/CabalCargs/Args.hs +++ b/lib/CabalCargs/Args.hs @@ -1,6 +1,9 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} -module CabalCargs.Args where +module CabalCargs.Args + ( Args(..) + , get + ) where import System.Console.CmdArgs import CabalCargs.Field (Field) @@ -34,7 +37,7 @@ get :: IO Args get = cmdArgs $ Args { library = def &= help "Only the compiler args of the library section are printed out." - , executable = def &= typ "NAME" &= help "Only the compiler args of the library section are printed out." + , executable = def &= typ "NAME" &= help "Only the compiler args of the executable section are printed out." , testSuite = def &= typ "NAME" &= help "Only the compiler args of the test suite section are printed out." , benchmark = def &= typ "NAME" &= help "Only the compiler args of the benchmark section are printed out." , only = def &= typ "FIELD" &= help "Only the specified compiler args are printed out, otherwise all args are printed out. The field name equals the ones in the cabal file, just the '-' replaced by a '_' e.g.: hs_source_dirs, ghc_options, cpp_options ..." diff --git a/lib/CabalCargs/BuildInfo.hs b/lib/CabalCargs/BuildInfo.hs new file mode 100644 --- /dev/null +++ b/lib/CabalCargs/BuildInfo.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE TemplateHaskell, Rank2Types, PatternGuards #-} + +module CabalCargs.BuildInfo + ( buildInfosOfLib + , buildInfosOfExe + , buildInfosOfTest + , buildInfosOfBenchmark + , buildInfosOf + , buildInfos + , field + ) where + +import Distribution.PackageDescription +import Distribution.Compiler +import Distribution.Package (Dependency) +import Language.Haskell.Extension +import Control.Lens +import Data.List (find) +import qualified CabalCargs.Sections as S +import qualified CabalCargs.Field as F +import qualified CabalCargs.CondVars as CV + + +makeLensesFor [ ("hsSourceDirs" , "hsSourceDirsL") + , ("options" , "optionsL") + , ("defaultLanguage" , "defaultLanguageL") + , ("cppOptions" , "cppOptionsL") + , ("cSources" , "cSourcesL") + , ("ccOptions" , "ccOptionsL") + , ("extraLibDirs" , "extraLibDirsL") + , ("extraLibs" , "extraLibsL") + , ("ldOptions" , "ldOptionsL") + , ("includeDirs" , "includeDirsL") + , ("includes" , "includesL") + ] ''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 libBuildInfo $ condTreeDatas vars condLib + + | otherwise + = [] + + +buildInfosOfExe :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfExe name vars pkgDescrp + | Just (_, condExe) <- find ((== name) . fst) $ condExecutables pkgDescrp + = map buildInfo $ condTreeDatas vars condExe + + | otherwise + = [] + + +buildInfosOfAllExes :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfAllExes vars pkgDescrp = + concat $ map ((map buildInfo) . (condTreeDatas vars) . snd) (condExecutables pkgDescrp) + + +buildInfosOfTest :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfTest name vars pkgDescrp + | Just (_, condTest) <- find ((== name) . fst) $ condTestSuites pkgDescrp + = map testBuildInfo $ condTreeDatas vars condTest + + | otherwise + = [] + + +buildInfosOfAllTests :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfAllTests vars pkgDescrp = + concat $ map ((map testBuildInfo) . (condTreeDatas vars) . snd) (condTestSuites pkgDescrp) + + +buildInfosOfBenchmark :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfBenchmark name vars pkgDescrp + | Just (_, condBench) <- find ((== name) . fst) $ condBenchmarks pkgDescrp + = map benchmarkBuildInfo $ condTreeDatas vars condBench + + | otherwise + = [] + + +buildInfosOfAllBenchmarks :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] +buildInfosOfAllBenchmarks vars pkgDescrp = + concat $ map ((map benchmarkBuildInfo) . (condTreeDatas vars) . snd) (condBenchmarks pkgDescrp) + + +-- | Returns all 'condTreeData' of the 'CondTree' which conditions match the given 'CondVars'. +condTreeDatas :: CV.CondVars -> CondTree ConfVar [Dependency] a -> [a] +condTreeDatas vars tree = go (condTreeComponents tree) [condTreeData tree] + where + go [] dats = dats + + go ((cond, ifTree, elseTree) : comps) dats + | CV.eval vars cond + = go comps $ go (condTreeComponents ifTree) (condTreeData ifTree : dats) + + | Just tree <- elseTree + = go comps $ go (condTreeComponents tree) (condTreeData tree : dats) + + | otherwise + = go comps dats + + +-- | A lens from a 'BuildInfo' to a list of stringified field entries of the 'BuildInfo'. +field :: F.Field -> Traversal' BuildInfo [String] +field F.Hs_Source_Dirs = hsSourceDirsL +field F.Ghc_Options = optionsL . traversed . filtered ((== GHC) . fst) . _2 +field F.Default_Extensions = oldAndDefaultExtensionsL . extsToStrings +field F.Default_Language = defaultLanguageL . langToString +field F.Cpp_Options = cppOptionsL +field F.C_Sources = cSourcesL +field F.Cc_Options = ccOptionsL +field F.Extra_Lib_Dirs = extraLibDirsL +field F.Extra_Libraries = extraLibsL +field F.Ld_Options = ldOptionsL +field F.Include_Dirs = includeDirsL +field F.Includes = includesL +field F.Package_Db = nopLens +field F.Autogen_Hs_Source_Dirs = nopLens +field F.Autogen_Include_Dirs = nopLens +field F.Autogen_Includes = nopLens + + +-- | A lens that merges the fields 'default-extensions' and 'extensions', +-- which now mean the same thing in cabal, 'extensions' is only the old +-- name of 'default-extensions'. +oldAndDefaultExtensionsL :: Lens' BuildInfo [Extension] +oldAndDefaultExtensionsL = lens getter setter + where + getter buildInfo = (oldExtensions buildInfo) ++ (defaultExtensions buildInfo) + setter buildInfo exts = buildInfo { defaultExtensions = exts } + + +-- | A lens (iso) that converts between a list of extensions +-- and a list of strings containing the names of the extensions. +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 + + +-- | A lens (iso) that converts between the language and +-- a list containing a string with the name of the language. +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 + + +-- | A lens that does nothing, always returns an empty +-- list and doesn't modify the given BuildInfo. +nopLens :: Lens' BuildInfo [String] +nopLens = lens (const []) (\buildInfo _ -> buildInfo) diff --git a/lib/CabalCargs/CompilerArgs.hs b/lib/CabalCargs/CompilerArgs.hs --- a/lib/CabalCargs/CompilerArgs.hs +++ b/lib/CabalCargs/CompilerArgs.hs @@ -12,12 +12,11 @@ import qualified CabalCargs.Sections as S import qualified CabalCargs.Field as F import qualified CabalCargs.Fields as Fs -import qualified CabalCargs.Lenses as L +import qualified CabalCargs.BuildInfo as B import Data.List (nub, foldl') import Data.Maybe (maybeToList) import Control.Applicative ((<$>)) import Control.Lens -import Control.Monad.Trans.Either (runEitherT) import qualified Filesystem.Path.CurrentOS as FP import Filesystem.Path (()) @@ -70,8 +69,7 @@ -- | Create a 'CompilerArgs' by the command line arguments given to 'cabal-cargs'. fromCmdArgs :: A.Args -> IO (Either Error CompilerArgs) -fromCmdArgs args = runEitherT $ do - fromSpec <$> Spec.fromCmdArgs args +fromCmdArgs args = (fromSpec <$>) <$> Spec.fromCmdArgs args -- | Create a 'CompilerArgs' and collect the compiler args specified by 'Spec'. @@ -138,14 +136,14 @@ addCarg buildInfos cargs field = cargs & (fieldL field) %~ nub . (++ buildInfoFields) where - buildInfoFields = concat $ map (^. L.field field) buildInfos + buildInfoFields = concat $ map (^. B.field field) buildInfos fields = case Spec.fields spec of Fs.Fields fs -> fs _ -> F.allFields - buildInfos = L.buildInfos (Spec.condVars spec) (Spec.cabalPackage spec) - buildInfosOf section = L.buildInfosOf section (Spec.condVars spec) (Spec.cabalPackage spec) + buildInfos = B.buildInfos (Spec.condVars spec) (Spec.cabalPackage spec) + buildInfosOf section = B.buildInfosOf section (Spec.condVars spec) (Spec.cabalPackage spec) packageDBL :: Lens' CompilerArgs [String] diff --git a/lib/CabalCargs/Lenses.hs b/lib/CabalCargs/Lenses.hs deleted file mode 100644 --- a/lib/CabalCargs/Lenses.hs +++ /dev/null @@ -1,199 +0,0 @@ -{-# LANGUAGE TemplateHaskell, Rank2Types, PatternGuards #-} - -module CabalCargs.Lenses - ( buildInfosOfLib - , buildInfosOfExe - , buildInfosOfTest - , buildInfosOfBenchmark - , buildInfosOf - , buildInfos - , field - ) where - -import Distribution.PackageDescription -import Distribution.Compiler -import Distribution.Package (Dependency) -import Language.Haskell.Extension -import Control.Lens -import Data.List (find) -import qualified CabalCargs.Sections as S -import qualified CabalCargs.Field as F -import qualified CabalCargs.CondVars as CV - - -makeLensesFor [ ("hsSourceDirs" , "hsSourceDirsL") - , ("options" , "optionsL") - , ("defaultLanguage" , "defaultLanguageL") - , ("cppOptions" , "cppOptionsL") - , ("cSources" , "cSourcesL") - , ("ccOptions" , "ccOptionsL") - , ("extraLibDirs" , "extraLibDirsL") - , ("extraLibs" , "extraLibsL") - , ("ldOptions" , "ldOptionsL") - , ("includeDirs" , "includeDirsL") - , ("includes" , "includesL") - ] ''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 libBuildInfo $ condTreeDatas vars condLib - - | otherwise - = [] - - -buildInfosOfExe :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfExe name vars pkgDescrp - | Just (_, condExe) <- find ((== name) . fst) $ condExecutables pkgDescrp - = map buildInfo $ condTreeDatas vars condExe - - | otherwise - = [] - - -buildInfosOfAllExes :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfAllExes vars pkgDescrp = - concat $ map ((map buildInfo) . (condTreeDatas vars) . snd) (condExecutables pkgDescrp) - - -buildInfosOfTest :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfTest name vars pkgDescrp - | Just (_, condTest) <- find ((== name) . fst) $ condTestSuites pkgDescrp - = map testBuildInfo $ condTreeDatas vars condTest - - | otherwise - = [] - - -buildInfosOfAllTests :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfAllTests vars pkgDescrp = - concat $ map ((map testBuildInfo) . (condTreeDatas vars) . snd) (condTestSuites pkgDescrp) - - -buildInfosOfBenchmark :: String -> CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfBenchmark name vars pkgDescrp - | Just (_, condBench) <- find ((== name) . fst) $ condBenchmarks pkgDescrp - = map benchmarkBuildInfo $ condTreeDatas vars condBench - - | otherwise - = [] - - -buildInfosOfAllBenchmarks :: CV.CondVars -> GenericPackageDescription -> [BuildInfo] -buildInfosOfAllBenchmarks vars pkgDescrp = - concat $ map ((map benchmarkBuildInfo) . (condTreeDatas vars) . snd) (condBenchmarks pkgDescrp) - - --- | Returns all 'condTreeData' of the 'CondTree' which conditions match the given 'CondVars'. -condTreeDatas :: CV.CondVars -> CondTree ConfVar [Dependency] a -> [a] -condTreeDatas vars tree = go (condTreeComponents tree) [condTreeData tree] - where - go [] dats = dats - - go ((cond, ifTree, elseTree) : comps) dats - | CV.eval vars cond - = go comps $ go (condTreeComponents ifTree) (condTreeData ifTree : dats) - - | Just tree <- elseTree - = go comps $ go (condTreeComponents tree) (condTreeData tree : dats) - - | otherwise - = go comps dats - - --- | A lens from a 'BuildInfo' to a list of stringified field entries of the 'BuildInfo'. -field :: F.Field -> Traversal' BuildInfo [String] -field F.Hs_Source_Dirs = hsSourceDirsL -field F.Ghc_Options = optionsL . traversed . filtered ((== GHC) . fst) . _2 -field F.Default_Extensions = oldAndDefaultExtensionsL . extsToStrings -field F.Default_Language = defaultLanguageL . langToString -field F.Cpp_Options = cppOptionsL -field F.C_Sources = cSourcesL -field F.Cc_Options = ccOptionsL -field F.Extra_Lib_Dirs = extraLibDirsL -field F.Extra_Libraries = extraLibsL -field F.Ld_Options = ldOptionsL -field F.Include_Dirs = includeDirsL -field F.Includes = includesL -field F.Package_Db = nopLens -field F.Autogen_Hs_Source_Dirs = nopLens -field F.Autogen_Include_Dirs = nopLens -field F.Autogen_Includes = nopLens - - --- | A lens that merges the fields 'default-extensions' and 'extensions', --- which now mean the same thing in cabal, 'extensions' is only the old --- name of 'default-extensions'. -oldAndDefaultExtensionsL :: Lens' BuildInfo [Extension] -oldAndDefaultExtensionsL = lens getter setter - where - getter buildInfo = (oldExtensions buildInfo) ++ (defaultExtensions buildInfo) - setter buildInfo exts = buildInfo { defaultExtensions = exts } - - --- | A lens (iso) that converts between a list of extensions --- and a list of strings containing the names of the extensions. -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 - - --- | A lens (iso) that converts between the language and --- a list containing a string with the name of the language. -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 - - --- | A lens that does nothing, always returns an empty --- list and doesn't modify the given BuildInfo. -nopLens :: Lens' BuildInfo [String] -nopLens = lens (const []) (\buildInfo _ -> buildInfo) diff --git a/lib/CabalCargs/Spec.hs b/lib/CabalCargs/Spec.hs --- a/lib/CabalCargs/Spec.hs +++ b/lib/CabalCargs/Spec.hs @@ -10,13 +10,13 @@ import Distribution.PackageDescription.Parse (parsePackageDescription, ParseResult(..)) import qualified Distribution.System as Sys import CabalCargs.Args (Args) -import qualified CabalCargs.Lenses as L +import qualified CabalCargs.BuildInfo as B import qualified CabalCargs.Args as A import qualified CabalCargs.Sections as S import qualified CabalCargs.Fields as F import qualified CabalCargs.CondVars as CV import qualified System.IO.Strict as Strict -import Control.Monad.Trans.Either (EitherT, left, right) +import Control.Monad.Trans.Either (EitherT, left, right, runEitherT) import Control.Monad.IO.Class import Control.Monad (filterM) import Control.Applicative ((<$>)) @@ -52,9 +52,9 @@ -- 'fromCabalFile', if only a cabal file was given, like 'fromSourceFile', -- if only a source file was given or like a mix of both, if a cabal file -- and a source file have been given. -fromCmdArgs :: Args -> EitherT Error IO Spec +fromCmdArgs :: Args -> IO (Either Error Spec) fromCmdArgs args - | Just cabalFile <- A.cabalFile args = do + | Just cabalFile <- A.cabalFile args = runEitherT $ do spec <- fromCabalFile cabalFile (S.sections args) (F.fields args) srcSections <- io $ case A.sourceFile args of Just srcFile -> findSections srcFile cabalFile (cabalPackage spec) @@ -64,7 +64,7 @@ , relativePaths = A.relative args } - | Just sourceFile <- A.sourceFile args = do + | Just sourceFile <- A.sourceFile args = runEitherT $ do spec <- fromSourceFile sourceFile (F.fields args) let specSections = case sections spec of S.Sections ss -> ss @@ -74,7 +74,7 @@ , relativePaths = A.relative args } - | otherwise = do + | otherwise = runEitherT $ do curDir <- io $ getCurrentDirectory cabalFile <- findCabalFile curDir spec <- fromCabalFile cabalFile (S.sections args) (F.fields args) @@ -211,15 +211,15 @@ fromBuildInfo (section, buildInfos) = (section, toFPs $ concat $ (map PD.hsSourceDirs) (buildInfos condVars pkgDescrp)) - buildInfos = concat [ [ (S.Library, L.buildInfosOfLib) | isJust $ PD.condLibrary pkgDescrp ] + buildInfos = concat [ [ (S.Library, B.buildInfosOfLib) | isJust $ PD.condLibrary pkgDescrp ] , map fromExe (PD.condExecutables pkgDescrp) , map fromTest (PD.condTestSuites pkgDescrp) , map fromBenchm (PD.condBenchmarks pkgDescrp) ] - fromExe (name, _) = (S.Executable name, L.buildInfosOfExe name) - fromTest (name, _) = (S.TestSuite name, L.buildInfosOfTest name) - fromBenchm (name, _) = (S.Benchmark name, L.buildInfosOfBenchmark name) + fromExe (name, _) = (S.Executable name, B.buildInfosOfExe name) + fromTest (name, _) = (S.TestSuite name, B.buildInfosOfTest name) + fromBenchm (name, _) = (S.Benchmark name, B.buildInfosOfBenchmark name) toFPs = map FP.decodeString