diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2013 Benno Fünfstück +Copyright 2013-2014 Benno Fünfstück All rights reserved. diff --git a/dynamic-cabal.cabal b/dynamic-cabal.cabal --- a/dynamic-cabal.cabal +++ b/dynamic-cabal.cabal @@ -1,5 +1,5 @@ name: dynamic-cabal -version: 0.3 +version: 0.3.1 license: BSD3 category: Distribution cabal-version: >= 1.10 diff --git a/src/Distribution/Client/Dynamic/PackageDescription.hs b/src/Distribution/Client/Dynamic/PackageDescription.hs --- a/src/Distribution/Client/Dynamic/PackageDescription.hs +++ b/src/Distribution/Client/Dynamic/PackageDescription.hs @@ -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 diff --git a/src/Distribution/Client/Dynamic/Query.hs b/src/Distribution/Client/Dynamic/Query.hs --- a/src/Distribution/Client/Dynamic/Query.hs +++ b/src/Distribution/Client/Dynamic/Query.hs @@ -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 - diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 ()"