diff --git a/CabalHelper/Data.hs b/CabalHelper/Data.hs
--- a/CabalHelper/Data.hs
+++ b/CabalHelper/Data.hs
@@ -15,6 +15,7 @@
-- along with this program. If not, see .
{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fforce-recomp #-}
module CabalHelper.Data where
import Control.Monad
diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -43,6 +43,7 @@
componentBuildInfo,
externalPackageDeps,
withComponentsLBI,
+ withLibLBI,
inplacePackageId)
import Distribution.Simple.GHC (componentGhcOptions)
@@ -88,7 +89,7 @@
++"DIST_DIR ( version\n"
++" | print-lbi\n"
++" | write-autogen-files\n"
- ++" | ghc-options [--with-inplace]\n"
+ ++" | ghc-options [--with-inplace]\n"
++" | ghc-src-options [--with-inplace]\n"
++" | ghc-pkg-options [--with-inplace]\n"
++" | entrypoints\n"
@@ -124,11 +125,8 @@
let
-- a =<< b $$ c == (a =<< b) $$ c
- -- a <$$> b $$ c == a <$$> (b $$ c)
infixr 2 $$
($$) = ($)
- infixr 1 <$$>
- (<$$>) = (<$>)
collectCmdOptions :: [String] -> [[String]]
collectCmdOptions =
@@ -157,30 +155,31 @@
initialBuildSteps distdir pd lbi v
return Nothing
- "ghc-options":flags ->
- Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
- \c clbi bi -> let
+ "ghc-options":flags -> do
+ res <- componentsMap lbi v distdir $ \c clbi bi -> let
outdir = componentOutDir lbi c
(clbi', adopts) = case flags of
["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps pd clbi
+ [] -> removeInplaceDeps v lbi pd clbi
+
+
opts = componentGhcOptions v lbi bi clbi' outdir
- in
- renderGhcOptions' lbi v $ opts `mappend` adopts
+ in renderGhcOptions' lbi v (opts `mappend` adopts)
+ return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
- "ghc-src-options":flags ->
- Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
- \c clbi bi -> let
+ "ghc-src-options":flags -> do
+ res <- componentsMap lbi v distdir $ \c clbi bi -> let
outdir = componentOutDir lbi c
(clbi', adopts) = case flags of
["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps pd clbi
+ [] -> removeInplaceDeps v lbi pd clbi
opts = componentGhcOptions v lbi bi clbi' outdir
comp = compiler lbi
opts' = mempty {
-- Not really needed but "unexpected package db stack: []"
ghcOptPackageDBs = [GlobalPackageDB],
+
ghcOptCppOptions = ghcOptCppOptions opts,
ghcOptCppIncludePath = ghcOptCppIncludePath opts,
ghcOptCppIncludes = ghcOptCppIncludes opts,
@@ -188,17 +187,16 @@
ghcOptSourcePathClear = ghcOptSourcePathClear opts,
ghcOptSourcePath = ghcOptSourcePath opts
}
- in
- renderGhcOptions' lbi v $ opts `mappend` adopts
+ in renderGhcOptions' lbi v $ opts `mappend` adopts
+ return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
- "ghc-pkg-options":flags ->
- Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
- \c clbi bi -> let
+ "ghc-pkg-options":flags -> do
+ res <- componentsMap lbi v distdir $ \c clbi bi -> let
comp = compiler lbi
outdir = componentOutDir lbi c
(clbi', adopts) = case flags of
["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps pd clbi
+ [] -> removeInplaceDeps v lbi pd clbi
opts = componentGhcOptions v lbi bi clbi' outdir
opts' = mempty {
@@ -206,23 +204,23 @@
ghcOptPackages = ghcOptPackages opts,
ghcOptHideAllPackages = ghcOptHideAllPackages opts
}
- in
- renderGhcOptions' lbi v $ opts' `mappend` adopts
+ in renderGhcOptions' lbi v $ opts' `mappend` adopts
+ return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
"entrypoints":[] -> do
eps <- componentsMap lbi v distdir $ \c clbi bi ->
return $ componentEntrypoints c
-- MUST append Setup component at the end otherwise CabalHelper gets
-- confused
- let eps' = eps ++ [(GmSetupHsName, Right [GmModuleName "Setup"])]
- return $ Just $ GmCabalHelperEntrypoints eps'
+ let eps' = eps ++ [(ChSetupHsName, ChSetupEntrypoint)]
+ return $ Just $ ChResponseEntrypoints eps'
- "source-dirs":[] ->
- Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
- \c clbi bi -> return $ hsSourceDirs bi
+ "source-dirs":[] -> do
+ res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi
+ return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
"print-lbi":[] ->
- return $ Just $ GmCabalHelperLbi $ show lbi
+ return $ Just $ ChResponseLbi $ show lbi
cmd:_ | not (cmd `elem` commands) ->
errMsg ("Unknown command: " ++ cmd) >> usage >> exitFailure
@@ -236,6 +234,15 @@
withLib pd (writeIORef lr)
readIORef lr
+getLibraryClbi pd lbi = unsafePerformIO $ do
+ lr <- newIORef (error "getLibraryClbi: empty IORef")
+
+ withLibLBI pd lbi $ \ lib clbi ->
+ writeIORef lr (lib,clbi)
+
+ readIORef lr
+
+
componentsMap :: LocalBuildInfo
-> Verbosity
-> FilePath
@@ -243,7 +250,7 @@
-> ComponentLocalBuildInfo
-> BuildInfo
-> IO a)
- -> IO [(GmComponentName, a)]
+ -> IO [(ChComponentName, a)]
componentsMap lbi v distdir f = do
let pd = localPkgDescr lbi
@@ -255,13 +262,14 @@
l' <- readIORef lr
r <- f c clbi bi
- writeIORef lr $ (componentNameToGm name, r):l'
+ writeIORef lr $ (componentNameToCh name, r):l'
+
reverse <$> readIORef lr
-componentNameToGm CLibName = GmLibName
-componentNameToGm (CExeName n) = GmExeName n
-componentNameToGm (CTestName n) = GmTestName n
-componentNameToGm (CBenchName n) = GmBenchName n
+componentNameToCh CLibName = ChLibName
+componentNameToCh (CExeName n) = ChExeName n
+componentNameToCh (CTestName n) = ChTestName n
+componentNameToCh (CBenchName n) = ChBenchName n
componentNameFromComponent (CLib Library {}) = CLibName
componentNameFromComponent (CExe Executable {..}) = CExeName exeName
@@ -277,24 +285,26 @@
componentOutDir lbi (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ _, ..})=
exeOutDir lbi benchmarkName
-gmModuleName :: C.ModuleName -> GmModuleName
-gmModuleName = GmModuleName . intercalate "." . components
+gmModuleName :: C.ModuleName -> ChModuleName
+gmModuleName = ChModuleName . intercalate "." . components
-componentEntrypoints :: Component -> Either FilePath [GmModuleName]
+componentEntrypoints :: Component -> ChEntrypoint
componentEntrypoints (CLib Library {..})
- = Right $ map gmModuleName $ exposedModules ++ (otherModules libBuildInfo)
+ = ChLibEntrypoint
+ (map gmModuleName exposedModules)
+ (map gmModuleName $ otherModules libBuildInfo)
componentEntrypoints (CExe Executable {..})
- = Left modulePath
-componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp })
- = Left fp
-componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn })
- = Right [gmModuleName mn]
+ = ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo)
+componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})
+ = ChExeEntrypoint fp (map gmModuleName $ otherModules testBuildInfo)
+componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn, ..})
+ = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo)
componentEntrypoints (CTest TestSuite {})
- = Right []
-componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ fp})
- = Left fp
+ = ChLibEntrypoint [] []
+componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ fp, ..})
+ = ChExeEntrypoint fp (map gmModuleName $ otherModules benchmarkBuildInfo)
componentEntrypoints (CBench Benchmark {})
- = Left []
+ = ChLibEntrypoint [] []
exeOutDir :: LocalBuildInfo -> String -> FilePath
exeOutDir lbi exeName =
@@ -309,26 +319,24 @@
in targetDir
-removeInplaceDeps :: PackageDescription
+removeInplaceDeps :: Verbosity
+ -> LocalBuildInfo
+ -> PackageDescription
-> ComponentLocalBuildInfo
-> (ComponentLocalBuildInfo, GhcOptions)
-removeInplaceDeps pd clbi = let
+removeInplaceDeps v lbi pd clbi = let
+ (lib, libclbi) = getLibraryClbi pd lbi
+ libbi = libBuildInfo lib
+ liboutdir = componentOutDir lbi (CLib lib)
+ libopts = (componentGhcOptions v lbi libbi libclbi liboutdir) {
+ ghcOptPackageDBs = []
+ }
+
(ideps, deps) = partition isInplaceDep (componentPackageDeps clbi)
hasIdeps = not $ null ideps
clbi' = clbi { componentPackageDeps = deps }
- lib = getLibrary pd
- src_dirs = hsSourceDirs (libBuildInfo lib)
- adopts = mempty {
- ghcOptSourcePath =
-#if CABAL_MAJOR == 1 && CABAL_MINOR >= 22
- toNubListR src_dirs
-#else
- src_dirs
-#endif
- }
-
- in (clbi', if hasIdeps then adopts else mempty)
+ in (clbi', if hasIdeps then libopts else mempty)
where
isInplaceDep :: (InstalledPackageId, PackageId) -> Bool
diff --git a/CabalHelper/Types.hs b/CabalHelper/Types.hs
--- a/CabalHelper/Types.hs
+++ b/CabalHelper/Types.hs
@@ -14,27 +14,35 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
+{-# LANGUAGE DeriveGeneric, DefaultSignatures #-}
module CabalHelper.Types where
+import GHC.Generics
+
newtype ChModuleName = ChModuleName String
- deriving (Eq, Ord, Read, Show)
+ deriving (Eq, Ord, Read, Show, Generic)
data ChComponentName = ChSetupHsName
| ChLibName
| ChExeName String
| ChTestName String
| ChBenchName String
- deriving (Eq, Ord, Read, Show)
+ deriving (Eq, Ord, Read, Show, Generic)
-data Response
- = ResponseStrings [(ChComponentName, [String])]
- | ResponseEntrypoints [(ChComponentName, ChEntrypoint)]
- | ResponseLbi String
- deriving (Eq, Ord, Read, Show)
+data ChResponse
+ = ChResponseStrings [(ChComponentName, [String])]
+ | ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]
+ | ChResponseLbi String
+ deriving (Eq, Ord, Read, Show, Generic)
-data ChEntrypoint = ChExeEntrypoint { chMainIs :: FilePath
+data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but
+ -- @main-is@ could either be @"Setup.hs"@
+ -- or @"Setup.lhs"@. Since we don't know
+ -- where the source directory is you have
+ -- to find these files.
+ | ChLibEntrypoint { chExposedModules :: [ChModuleName]
, chOtherModules :: [ChModuleName]
}
- | ChLibentrypoint { chExposedModules :: [ChModuleName]
+ | ChExeEntrypoint { chMainIs :: FilePath
, chOtherModules :: [ChModuleName]
- } deriving (Eq, Ord, Read, Show)
+ } deriving (Eq, Ord, Read, Show, Generic)
diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs
--- a/CabalHelper/Wrapper.hs
+++ b/CabalHelper/Wrapper.hs
@@ -236,15 +236,15 @@
, "-optP-DCABAL_MAJOR=" ++ show mj
, "-optP-DCABAL_MINOR=" ++ show mi
],
- maybeToList $ ("-package-db="++) <$> packageDb,
- map ("-i"++) $ cabalHelperSourceDir:maybeToList cabalSourceDir,
+ maybeToList $ ("-package-conf="++) <$> packageDb,
+ map ("-i"++) $ ".":maybeToList cabalSourceDir,
concatMap (\p -> ["-package", p]) packageDeps,
- [ "--make", cabalHelperSourceDir "CabalHelper/Main.hs" ]
+ [ "--make", "CabalHelper/Main.hs" ]
]
-- TODO: touch exe after, ghc doesn't do that if the input files didn't
-- actually change
- rv <- callProcessStderr' Nothing ghcProgram ghc_opts
+ rv <- callProcessStderr' (Just cabalHelperSourceDir) ghcProgram ghc_opts
return $ case rv of
ExitSuccess -> Right exe
e@(ExitFailure _) -> Left e
@@ -353,7 +353,7 @@
-- TODO: Include sandbox? Probably only relevant for build-type:custom projects.
listCabalVersions' :: Options -> Maybe FilePath -> IO [Version]
listCabalVersions' Options {..} mdb = do
- let mdbopt = ("--package-db="++) <$> mdb
+ let mdbopt = ("--package-conf="++) <$> mdb
opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
catMaybes . map (fmap snd . parsePkgId . fromString) . words
diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs
--- a/Distribution/Helper.hs
+++ b/Distribution/Helper.hs
@@ -14,15 +14,16 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
-{-# LANGUAGE CPP, FlexibleContexts, ConstraintKinds, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, FlexibleContexts, ConstraintKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric #-}
+
module Distribution.Helper (
Programs(..)
-- * Running Queries
, Query
, runQuery
- , runKQuery
- , runKQuery_
+ , runQuery'
-- * Queries against Cabal\'s on disk state
@@ -62,6 +63,7 @@
import System.Directory
import System.Process
import Text.Printf
+import GHC.Generics
import Paths_cabal_helper (getLibexecDir)
import CabalHelper.Types
@@ -71,7 +73,7 @@
cabalProgram :: FilePath,
ghcProgram :: FilePath,
ghcPkgProgram :: FilePath
- }
+ } deriving (Eq, Ord, Show, Read, Generic, Typeable)
instance Default Programs where
def = Programs "cabal" "ghc" "ghc-pkg"
@@ -89,6 +91,7 @@
-- running all possible queries against it at once is cheap.
newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo)
(ReaderT (Programs, FilePath) m) a }
+ deriving (Functor, Applicative, Monad)
type MonadQuery m = ( MonadIO m
, MonadState (Maybe SomeLocalBuildInfo) m
@@ -99,25 +102,17 @@
-- | @runQuery query distdir@. Run a 'Query'. @distdir@ is where Cabal's
-- @setup-config@ file is located.
runQuery :: Monad m
- => Query m a
- -> FilePath -- ^ Path to @dist/@
+ => FilePath -- ^ Path to @dist/@
+ -> Query m a
-> m a
-runQuery action fp = run (def, fp) Nothing action
-
--- | Run a 'Query' as an Arrow by wrapping it in a 'Kleisli' constructor.
-runKQuery :: Monad m
- => Kleisli (Query m) a b
- -> FilePath -- ^ Path to @dist/@
- -> a
- -> m b
-runKQuery (Kleisli action) fp a = run (def, fp) Nothing (action a)
+runQuery fp action = run (def, fp) Nothing action
--- | Same as 'runKQuery' but pass unit as input to the arrow.
-runKQuery_ :: Monad m
- => Kleisli (Query m) () b
- -> FilePath -- ^ Path to @dist/@
- -> m b
-runKQuery_ (Kleisli action) fp = run (def, fp) Nothing (action ())
+runQuery' :: Monad m
+ => Programs
+ -> FilePath -- ^ Path to @dist/@
+ -> Query m a
+ -> m a
+runQuery' progs fp action = run (progs, fp) Nothing action
getSlbi :: MonadQuery m => m SomeLocalBuildInfo
getSlbi = do
@@ -192,11 +187,11 @@
, intercalate " " (map show $ distdir:args)
, " (read failed)"]
- let [ Just (ResponseEntrypoints eps),
- Just (ResponseStrings srcDirs),
- Just (ResponseStrings ghcOpts),
- Just (ResponseStrings ghcSrcOpts),
- Just (ResponseStrings ghcPkgOpts) ] = res
+ let [ Just (ChResponseEntrypoints eps),
+ Just (ChResponseStrings srcDirs),
+ Just (ChResponseStrings ghcOpts),
+ Just (ChResponseStrings ghcSrcOpts),
+ Just (ChResponseStrings ghcPkgOpts) ] = res
return $ SomeLocalBuildInfo eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts
diff --git a/cabal-helper.cabal b/cabal-helper.cabal
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -1,35 +1,33 @@
name: cabal-helper
-version: 0.2.0.0
+version: 0.3.0.0
synopsis: Simple interface to Cabal's configuration state used by ghc-mod
description:
@cabal-helper@ provides a library which wraps the internal use of executables
to lift the restrictions imposed by linking against versions of GHC before
@7.10@.
-
+ .
@cabal-helper@ uses a wrapper executable to compile the actual cabal-helper
executable at runtime while linking against an arbitrary version of
Cabal. This runtime-compiled helper executable is then used to extract
various bits and peices from Cabal\'s on disk state (dist/setup-config)
written by it's configure command.
-
+ .
In addition to this the wrapper executable also supports installing any
version of Cabal from hackage in case it cannot be found in any available
package database. The wrapper installs these instances of the Cabal library
into a private package database so as to not interfere with the user's
packages.
-
+ .
Furthermore the wrapper supports one special case namely reading a state
file for Cabal itself. This is needed as Cabal compiles it's Setup.hs using
itself and not using any version of Cabal installed in any package database.
- Currently @cabal-helper@ supports @Cabal >= 1.16@.
-
license: AGPL-3
license-file: LICENSE
author: Daniel Gröber
maintainer: dxld@darkboxed.org
category: Distribution
-build-type: Simple
+build-type: Custom
cabal-version: >=1.10
extra-source-files: CabalHelper/Main.hs
@@ -39,15 +37,17 @@
library
exposed-modules: Distribution.Helper
- build-depends: base >= 4.5 && < 5
+ Other-Modules: Paths_cabal_helper
+ , CabalHelper.Types
default-language: Haskell2010
- Build-Depends: base
+ Build-Depends: base >= 4.5 && < 5
, data-default
, directory
, filepath
, transformers
, mtl
, process
+ , ghc-prim
Executable cabal-helper-wrapper
Default-Language: Haskell2010
@@ -62,7 +62,7 @@
X-Install-Target: $libexecdir
Build-Depends: base >= 4.5 && < 5
, bytestring
- , Cabal
+ , Cabal >= 1.16 && <= 1.22
, directory
, filepath
, process