dynamic-cabal 0.3 → 0.3.1
raw patch · 6 files changed
+75/−60 lines, 6 files
Files
- .travis.yml +1/−3
- LICENSE +1/−1
- dynamic-cabal.cabal +1/−1
- src/Distribution/Client/Dynamic/PackageDescription.hs +45/−33
- src/Distribution/Client/Dynamic/Query.hs +16/−11
- tests/Main.hs +11/−11
.travis.yml view
@@ -1,7 +1,7 @@ env: - GHCVER=7.4.2 CABALVER=1.16 - GHCVER=7.6.3 CABALVER=1.18- - GHCVER=head CABALVER=1.18 + - GHCVER=7.8.1 CABALVER=1.18 before_install: - sudo add-apt-repository -y ppa:hvr/ghc@@ -19,6 +19,4 @@ - hlint src matrix:- allow_failures:- - env: GHCVER=head CABALVER=1.18 fast_finish: true
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2013 Benno Fünfstück+Copyright 2013-2014 Benno Fünfstück All rights reserved.
dynamic-cabal.cabal view
@@ -1,5 +1,5 @@ name: dynamic-cabal-version: 0.3+version: 0.3.1 license: BSD3 category: Distribution cabal-version: >= 1.10
src/Distribution/Client/Dynamic/PackageDescription.hs view
@@ -25,7 +25,7 @@ -- Type tags that we can use to make sure we don't accidently generate code that -- use a function for a PackageDescription on a BuildInfo value. --- | A package description type. This type has no constructors, and is only used +-- | A package description type. This type has no constructors, and is only used -- for type-safety purposes. data PackageDescription data BuildInfo@@ -65,11 +65,11 @@ { -- | The specific info of the target info :: TargetInfo - -- | All dependencies of the target, with their versions. If the version is not resolved yet, it'll be Nothing. + -- | All dependencies of the target, with their versions. If the version is not resolved yet, it'll be Nothing. -- That only happens when the target is not enabled, though. , dependencies :: [(String, Maybe Version)] - -- | Directories where to look for source files. + -- | Directories where to look for source files. , sourceDirs :: [FilePath] -- | Directories where to look for header files.@@ -81,7 +81,7 @@ -- | Additional options to pass to CPP preprocessor when compiling source files. , cppOptions :: [String] - -- | The extensions to enable/disable. The elements are like GHC's -X flags, a disabled extension + -- | The extensions to enable/disable. The elements are like GHC's -X flags, a disabled extension -- is represented as the extension name prefixed by 'No'. -- Example value: extensions = ["ScopedTypeVariables", "NoMultiParamTypeClasses"] , extensions :: [String]@@ -92,13 +92,15 @@ -- | other modules included in the target , otherModules :: [String] + -- | The 'c-sources' field in the package description.+ , cSources :: [String]+ -- | Whether this target was enabled or not. This only matters for Benchmarks or Tests, Executables and Libraries are always enabled. , enabled :: Bool- } deriving (Show, Eq, Read) instance Default Target where- def = Target def def def def def def def True def True+ def = Target def def def def def def def True def def True (<&>) :: Functor f => f a -> (a -> b) -> f b (<&>) = flip fmap@@ -133,6 +135,9 @@ _enabled :: Functor f => (Bool -> f Bool) -> Target -> f Target _enabled f t = f (enabled t) <&> \e -> t { enabled = e } +_cSources :: Functor f => ([String] -> f [String]) -> Target -> f Target+_cSources f t = f (cSources t) <&> \cs -> t { cSources = cs }+ -- | return the target name, or the empty string for the library target targetName :: Target -> String targetName t = case info t of@@ -171,6 +176,9 @@ hsSourceDirs' :: Selector BuildInfo [FilePath] hsSourceDirs' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "hsSourceDirs" +cSources' :: Selector BuildInfo [FilePath]+cSources' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "cSources"+ -- | The include search path of a buildInfo. Same as the 'includeDir' field in Cabal's BuildInfo. includeDirs' :: Selector BuildInfo [FilePath] includeDirs' = selector $ const $ useValue "Distribution.PackageDescription" $ Ident "includeDirs"@@ -181,7 +189,7 @@ extensions' = selector $ const $ expr $ \bi -> applyE2 map' display' $ applyE concat' $ expr $ map (<>$ bi) [defaultExtensions', oldExtensions', otherExtensions'] where display' :: ExpG (Extension -> String) display' = useValue "Distribution.Text" $ Ident "display"- + defaultExtensions', oldExtensions',otherExtensions' :: ExpG (BuildInfo -> [Extension]) defaultExtensions' = useValue "Distribution.PackageDescription" $ Ident "defaultExtensions" oldExtensions' = useValue "Distribution.PackageDescription" $ Ident "oldExtensions"@@ -223,7 +231,7 @@ nameVar <- newName "name" versionVar <- newName "version" caseE dep- [ ( PApp dependency [PApp packageName [PVar nameVar], PVar versionVar], + [ ( PApp dependency [PApp packageName [PVar nameVar], PVar versionVar], tuple2 <>$ useVar nameVar <>$ applyE isSpecificVersion (useVar versionVar) ) ]@@ -233,22 +241,26 @@ -- | Construct a 'Target' from a buildInfo, a targetName and a Bool that is True if the target is enabled, false otherwise. buildInfoTarget :: Query BuildInfo (TargetInfo -> Bool -> Target)-buildInfoTarget = (\d src inc opts copts exts ba oths n-> Target n d src inc opts copts exts ba oths)- <$> query dependencies' - <*> query hsSourceDirs' - <*> query includeDirs' - <*> query ghcOptions'- <*> query cppOptions'- <*> query extensions'- <*> query buildable'- <*> query otherModules'+buildInfoTarget = pure Target+ <***> query dependencies'+ <***> query hsSourceDirs'+ <***> query includeDirs'+ <***> query ghcOptions'+ <***> query cppOptions'+ <***> query extensions'+ <***> query buildable'+ <***> query otherModules'+ <***> query cSources'+ where (<***>) :: Applicative f => f (a -> b -> c) -> f b -> f (a -> c)+ f <***> b = fmap flip f <*> b+ infixl 4 <***> --- | Get the buildInfo of the library in the package, and its exposed modules. If there is no library in the package, +-- | Get the buildInfo of the library in the package, and its exposed modules. If there is no library in the package, -- return the empty list. library' :: ExpG (PackageDescription -> [([String],BuildInfo)]) library' = applyE2 maybe' (returnE $ List []) serialize' <>. useValue "Distribution.PackageDescription" (Ident "library") where serialize' = expr $ \lib -> applyE2 cons (tuple2 <>$ applyE modNames' lib <>$ applyE buildInfo' lib) (returnE $ List [])- modNames'=applyE map' display' <>. mods'+ modNames' = applyE map' display' <>. mods' display' = useValue "Distribution.Text" $ Ident "display" mods' = useValue "Distribution.PackageDescription" $ Ident "exposedModules" buildInfo' = useValue "Distribution.PackageDescription" $ Ident "libBuildInfo"@@ -257,22 +269,22 @@ executables' :: ExpG (PackageDescription -> [((String,FilePath), BuildInfo)]) executables'= applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "executables") where serialize' = expr $ \exe -> tuple2 <>$ applyE exeInfo exe <>$ applyE buildInfo' exe- exeInfo= expr $ \exe -> tuple2 <>$ applyE exeName' exe <>$ applyE modulePath' exe + exeInfo= expr $ \exe -> tuple2 <>$ applyE exeName' exe <>$ applyE modulePath' exe exeName' = useValue "Distribution.PackageDescription" $ Ident "exeName" modulePath'= useValue "Distribution.PackageDescription" $ Ident "modulePath" buildInfo' = useValue "Distribution.PackageDescription" $ Ident "buildInfo" -- | Get the filepath of a exit-code-stdio interface (for test cases or benchmarks)--- The first argument specifies the constructor which contains the interface data. +-- The first argument specifies the constructor which contains the interface data. -- For test suites, this should be TestSuiteExeV10, for benchmarks, it should be BenchmarkExeV10.--- +-- -- Note: This function is not entirely typesafe, because the argument type of the returned function -- is polymorphic. You have to make sure that the type has the given constructor.-exitCodeStdioPath' :: String -> ExpG (a -> Maybe String) +exitCodeStdioPath' :: String -> ExpG (a -> Maybe String) exitCodeStdioPath' conName = expr $ \i -> do con <- useCon "Distribution.PackageDescription" $ Ident conName pathVar <- newName "filepath"- caseE i + caseE i [ (PApp con [PWildCard, PVar pathVar], applyE just' $ useVar pathVar) , (PWildCard, nothing') ]@@ -280,8 +292,8 @@ -- | Get the name, whether the target is enabled or not, possibly the main module path and the buildInfo of each testSuite in the package. tests' :: ExpG (PackageDescription -> [((String, Bool,Maybe FilePath), BuildInfo)]) tests' = applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "testSuites")- where serialize' = expr $ \test -> tuple2 - <>$ applyE3 tuple3 (testName' <>$ test) (testEnabled' <>$ test) (exitCodeStdioPath' "TestSuiteExeV10" <>. testInterface' <>$ test) + where serialize' = expr $ \test -> tuple2+ <>$ applyE3 tuple3 (testName' <>$ test) (testEnabled' <>$ test) (exitCodeStdioPath' "TestSuiteExeV10" <>. testInterface' <>$ test) <>$ applyE buildInfo' test testName' = useValue "Distribution.PackageDescription" $ Ident "testName" testEnabled' = useValue "Distribution.PackageDescription" $ Ident "testEnabled"@@ -291,15 +303,15 @@ -- | Get the name, whether it's enabled or not and the buildInfo of each benchmark in the package. benchmarks' :: ExpG (PackageDescription -> [((String, Bool,Maybe FilePath), BuildInfo)]) benchmarks' = applyE map' serialize' <>. useValue "Distribution.PackageDescription" (Ident "benchmarks")- where serialize' = expr $ \bench -> tuple2 - <>$ applyE3 tuple3 (benchName' <>$ bench) (benchEnabled' <>$ bench) (exitCodeStdioPath' "BenchmarkExeV10" <>. benchInterface' <>$ bench) + where serialize' = expr $ \bench -> tuple2+ <>$ applyE3 tuple3 (benchName' <>$ bench) (benchEnabled' <>$ bench) (exitCodeStdioPath' "BenchmarkExeV10" <>. benchInterface' <>$ bench) <>$ applyE buildInfo' bench benchName' = useValue "Distribution.PackageDescription" $ Ident "benchmarkName" benchEnabled' = useValue "Distribution.PackageDescription" $ Ident "benchmarkEnabled" buildInfo' = useValue "Distribution.PackageDescription" $ Ident "benchmarkBuildInfo" benchInterface' = useValue "Distribution.PackageDescription" $ Ident "benchmarkInterface"- --- | Get the name of all targets and whether they are enabled (second field True) or not. ++-- | Get the name of all targets and whether they are enabled (second field True) or not. -- The resulting list is in the same order and has the same length as the list returned -- by buildInfos. targetInfos :: Query PackageDescription [(TargetInfo, Bool)]@@ -328,17 +340,17 @@ buildInfos = selector $ const $ expr $ \bi -> applyE concat' $ expr $ map (<>$ bi) [libraryBI, exesBI, testsBI, benchsBI] where libraryBI :: ExpG (PackageDescription -> [BuildInfo]) libraryBI = applyE map' snd' <>. library'- + exesBI :: ExpG (PackageDescription -> [BuildInfo]) exesBI = applyE map' snd' <>. executables'- + testsBI :: ExpG (PackageDescription -> [BuildInfo]) testsBI = applyE map' snd' <>. tests' benchsBI :: ExpG (PackageDescription -> [BuildInfo]) benchsBI = applyE map' snd' <>. benchmarks' --- | Query the available targets. This will return all targets, even disabled ones. +-- | Query the available targets. This will return all targets, even disabled ones. -- If a package is disabled or not buildable, it's possible that not all dependencies have versions, some can be Nothing. targets :: Query PackageDescription [Target] targets = zipWith uncurry <$> on buildInfos (fmapQ buildInfoTarget) <*> targetInfos
src/Distribution/Client/Dynamic/Query.hs view
@@ -12,7 +12,7 @@ #endif -- | Functions for building queries on cabal's setup-config an evaluating them.-module Distribution.Client.Dynamic.Query +module Distribution.Client.Dynamic.Query ( Selector(), selector , Query(), query , LocalBuildInfo()@@ -30,7 +30,6 @@ import Control.Category import qualified Control.Exception as E import Control.Monad-import Data.Dynamic import Data.Version import Data.Void import qualified DynFlags@@ -45,9 +44,15 @@ import System.IO.Error (isAlreadyExistsError) import Text.ParserCombinators.ReadP +#if __GLASGOW_HASKELL__ >= 708+import Data.Dynamic hiding (Typeable1)+#else+import Data.Dynamic+#endif+ #if __GLASGOW_HASKELL__ >= 707 type Typeable1 (f :: * -> *) = Typeable f-#endif +#endif -- | This is just a dummy type representing a LocalBuildInfo. You don't have to use -- this type, it is just used to tag queries and make them more type-safe.@@ -85,7 +90,7 @@ selector = Selector -- | A query is like a Selector, but it cannot be composed any futher using a Category instance.--- It can have a Functor and Applicative instance though. +-- It can have a Functor and Applicative instance though. -- To execute a query, you only need to run GHC once. data Query s a = forall i. Typeable i => Query (Selector s i) (i -> a) @@ -111,7 +116,7 @@ getRunDirectory :: IO FilePath getRunDirectory = getTemporaryDirectory >>= go 0 where go :: Integer -> FilePath -> IO FilePath- go !c dir = do + go !c dir = do let cdir = dir </> "dynamic-cabal" <.> show c res <- E.try $ createDirectory cdir case res of@@ -143,10 +148,10 @@ res <$ removeDirectoryRecursive tmp generateSource :: Selector LocalBuildInfo o -> String -> FilePath -> Version -> IO String-generateSource (Selector s) modName setupConfig version = +generateSource (Selector s) modName setupConfig version = return $ flip generateModule modName $ do- getLBI <- addDecl (Ident "getLBI") $ - applyE fmap' (read' <>. unlines' <>. applyE drop' 1 <>. lines' :: ExpG (String -> LocalBuildInfo)) + getLBI <- addDecl (Ident "getLBI") $+ applyE fmap' (read' <>. unlines' <>. applyE drop' 1 <>. lines' :: ExpG (String -> LocalBuildInfo)) <>$ applyE readFile' (expr setupConfig) result <- addDecl (Ident "result") $ applyE fmap' (s version) <>$ expr getLBI return $ Just [exportFun result]@@ -158,12 +163,12 @@ version <- getCabalVersion setupConfig' src<- generateSource s "DynamicCabalQuery" setupConfig' version runRawQuery' src setupConfig post- + -- | Run a raw query, getting the full source from the first parameter -- the module must be DynamicCabalQuery and it must have a result declaration runRawQuery :: Typeable a => String -> FilePath -> IO a runRawQuery s setupConfig = runRawQuery' s setupConfig id- + -- | Run a raw query, getting the full source from the first parameter. -- The module must be DynamicCabalQuery and it must have a result declaration. -- The third argument is a function to apply to the result of running the query.@@ -179,6 +184,7 @@ { GHC.ghcLink = GHC.LinkInMemory , GHC.hscTarget = GHC.HscInterpreted , GHC.packageFlags = [DynFlags.ExposePackage $ "Cabal-" ++ showVersion version]+ , GHC.ctxtStkDepth = 1000 } dflags' <- GHC.getSessionDynFlags @@ -188,4 +194,3 @@ void $ GHC.load GHC.LoadAllTargets GHC.setContext [GHC.IIDecl $ GHC.simpleImportDecl $ GHC.mkModuleName "DynamicCabalQuery"] GHC.dynCompileExpr "result" >>= maybe (fail "dynamic-cabal: runQuery: Result expression has wrong type") (MonadUtils.liftIO . fmap post) . fromDynamic-
tests/Main.hs view
@@ -11,18 +11,18 @@ case_targets :: Assertion case_targets = do tgs <- runQuery (on localPkgDesc targets) "dist/setup-config"- assertEqual "target names" - (sort - [ Library + assertEqual "target names"+ (sort+ [ Library [ "Distribution.Client.Dynamic" , "Distribution.Client.Dynamic.Query"- , "Distribution.Client.Dynamic.LocalBuildInfo" + , "Distribution.Client.Dynamic.LocalBuildInfo" , "Distribution.Client.Dynamic.PackageDescription" ] , TestSuite "dynamic-cabal-tests" (Just "Main.hs") , TestSuite "doctests" (Just "doctests.hs")- ]) - (sort $ map info tgs) + ])+ (sort $ map info tgs) assertEqual "source directories" (sort $ map sourceDirs tgs) $ sort $ map return ["src", "tests", "tests"] assertBool "ghc options" $ all (elem "-Wall" . ghcOptions) tgs assertBool "no extensions" $ all (null . extensions) tgs@@ -46,8 +46,8 @@ src :: IO String src=do setupConfig' <- canonicalizePath "dist/setup-config"- cv<-getCabalVersion setupConfig'- let optStr=if cv>=Version [1,15,0] []+ cv <- getCabalVersion setupConfig'+ let optStr = if cv >= Version [1,15,0] [] then " let opts=renderGhcOptions ((fst $ head $ readP_to_S parseVersion \"7.6.3\") :: Version) $ componentGhcOptions V.silent lbi b clbi \"dist/build\"" else " let opts=ghcOptions lbi b clbi \"dist/build\"" return $ unlines [@@ -59,7 +59,7 @@ ,"import qualified Distribution.Verbosity as V" ,"import Data.Version (parseVersion)" ,"import Text.ParserCombinators.ReadP(readP_to_S)"- ,if cv>=Version [1,15,0] [] then "import Distribution.Simple.Program.GHC" else ""+ ,if cv >= Version [1,15,0] [] then "import Distribution.Simple.Program.GHC" else "" ,"import Distribution.Simple.GHC" ,"import Distribution.Version" ,"import Control.Monad"@@ -69,9 +69,9 @@ ,"lbi<-liftM (read . Prelude.unlines . drop 1 . lines) $ Prelude.readFile \""++setupConfig' ++"\"" ,"let pkg=localPkgDescr lbi" ,"r<-newIORef DM.empty"- ,"withComponentsLBI pkg lbi (\\c clbi->do"+ ,(if cv >= Version [1,18,0] [] then "withAllComponentsInBuildOrder" else "withComponentsLBI") ++ " pkg lbi (\\c clbi->do" ," let b=foldComponent libBuildInfo buildInfo testBuildInfo benchmarkBuildInfo c"- ,optStr + ,optStr ," let n=foldComponent (const \"\") exeName testName benchmarkName c" ," modifyIORef r (DM.insert n opts)" ," return ()"