{-# LANGUAGE DeriveFunctor, GADTs, ScopedTypeVariables #-}
module CabalHelper.Compiletime.Compile where
import qualified Cabal.Plan as CP
import Cabal.Plan
( PkgId(..), PkgName(..), Ver(..), uPId)
import Control.Applicative
import Control.Arrow
import Control.Exception as E
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Char
import Data.List
import Data.Map.Strict (Map)
import Data.Maybe
import Data.String
import Data.Version
import Text.Printf
import qualified System.Clock as Clock
import System.Directory
import System.FilePath
import System.Exit
import System.IO
import System.IO.Temp
import Prelude
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import Distribution.System
( buildPlatform )
import Distribution.Text
( display )
import CabalHelper.Compiletime.Cabal
import CabalHelper.Compiletime.Data
import CabalHelper.Compiletime.Log
import CabalHelper.Compiletime.Program.GHC
import CabalHelper.Compiletime.Program.CabalInstall
import CabalHelper.Compiletime.Sandbox
( getSandboxPkgDb )
import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.Types.Cabal
import CabalHelper.Shared.Common
import Paths_cabal_helper (version)
data Compile
= CompileWithCabalSource
{ Compile -> CabalSourceDir
compCabalSourceDir :: !CabalSourceDir
, Compile -> Version
compCabalSourceVersion :: !Version
}
| CompileWithCabalPackage
{ Compile -> GhcPackageSource
compPackageSource :: !GhcPackageSource
, Compile -> ResolvedCabalVersion
compCabalVersion :: !ResolvedCabalVersion
, Compile -> CompilationProductScope
compProductTarget :: !CompilationProductScope
}
data CompPaths = CompPaths
{ CompPaths -> FilePath
compBuildDir:: !FilePath
, CompPaths -> FilePath
compOutDir :: !FilePath
, CompPaths -> FilePath
compExePath :: !FilePath
}
data CompilationProductScope = CPSGlobal | CPSProject
type CompHelperEnv = CompHelperEnv' CabalVersion
data CompHelperEnv' cv = CompHelperEnv
{ CompHelperEnv' cv -> cv
cheCabalVer :: !cv
, CompHelperEnv' cv -> [PackageDbDir]
chePkgDb :: ![PackageDbDir]
, CompHelperEnv' cv -> FilePath
cheProjDir :: !FilePath
, CompHelperEnv' cv -> Maybe (Map UnitId Unit)
chePjUnits :: !(Maybe (Map CP.UnitId CP.Unit))
, CompHelperEnv' cv -> Maybe FilePath
cheDistV2 :: !(Maybe FilePath)
, CompHelperEnv' cv -> FilePath
cheProjLocalCacheDir :: FilePath
}
compileHelper
:: Env => CompHelperEnv -> IO (Either ExitCode FilePath)
compileHelper :: CompHelperEnv -> IO (Either ExitCode FilePath)
compileHelper che :: CompHelperEnv
che@CompHelperEnv {CabalVersion
cheCabalVer :: CabalVersion
cheCabalVer :: forall cv. CompHelperEnv' cv -> cv
cheCabalVer} = do
FilePath
-> (FilePath -> IO (Either ExitCode FilePath))
-> IO (Either ExitCode FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory "cabal-helper.compile-tmp" ((FilePath -> IO (Either ExitCode FilePath))
-> IO (Either ExitCode FilePath))
-> (FilePath -> IO (Either ExitCode FilePath))
-> IO (Either ExitCode FilePath)
forall a b. (a -> b) -> a -> b
$ \tmpdir :: FilePath
tmpdir -> do
UnpackedCabalVersion
ucv <- Env => CabalVersion -> FilePath -> IO UnpackedCabalVersion
CabalVersion -> FilePath -> IO UnpackedCabalVersion
unpackCabal CabalVersion
cheCabalVer FilePath
tmpdir
Env =>
CompHelperEnv' UnpackedCabalVersion
-> IO (Either ExitCode FilePath)
CompHelperEnv' UnpackedCabalVersion
-> IO (Either ExitCode FilePath)
compileHelper' CompHelperEnv
che { cheCabalVer :: UnpackedCabalVersion
cheCabalVer = UnpackedCabalVersion
ucv }
compileHelper'
:: Env
=> CompHelperEnv' UnpackedCabalVersion
-> IO (Either ExitCode FilePath)
compileHelper' :: CompHelperEnv' UnpackedCabalVersion
-> IO (Either ExitCode FilePath)
compileHelper' CompHelperEnv {..} = do
GhcVersion
ghcVer <- IO GhcVersion
(Verbose, Progs) => IO GhcVersion
ghcVersion
Just (prepare :: IO ()
prepare, comp :: Compile
comp) <- case UnpackedCabalVersion
cheCabalVer of
cabalVer :: UnpackedCabalVersion
cabalVer@CabalHEAD {} -> MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile)))
-> MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile))
forall a b. (a -> b) -> a -> b
$ [MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile))
-> [MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ ((GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile))
-> MaybeT IO (IO (), Compile))
-> [GhcVersion
-> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)]
-> [MaybeT IO (IO (), Compile)]
forall a b. (a -> b) -> [a] -> [b]
map (\f :: GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
f -> GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
f GhcVersion
ghcVer UnpackedCabalVersion
cabalVer)
[ Env =>
GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv'
, GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
forall (m :: * -> *).
(Env, MonadIO m) =>
GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb'
]
CabalVersion cabalVerPlain :: Version
cabalVerPlain -> do
MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile)))
-> MaybeT IO (IO (), Compile) -> IO (Maybe (IO (), Compile))
forall a b. (a -> b) -> a -> b
$ [MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile))
-> [MaybeT IO (IO (), Compile)] -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ ((GhcVersion -> Version -> MaybeT IO (IO (), Compile))
-> MaybeT IO (IO (), Compile))
-> [GhcVersion -> Version -> MaybeT IO (IO (), Compile)]
-> [MaybeT IO (IO (), Compile)]
forall a b. (a -> b) -> [a] -> [b]
map (\f :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
f -> GhcVersion -> Version -> MaybeT IO (IO (), Compile)
f GhcVersion
ghcVer Version
cabalVerPlain) ([GhcVersion -> Version -> MaybeT IO (IO (), Compile)]
-> [MaybeT IO (IO (), Compile)])
-> [GhcVersion -> Version -> MaybeT IO (IO (), Compile)]
-> [MaybeT IO (IO (), Compile)]
forall a b. (a -> b) -> a -> b
$
case [PackageDbDir]
chePkgDb of
[] ->
[ Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2Inplace
, Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv
, GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileCabalSource
, Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileSandbox
, GhcVersion -> Version -> MaybeT IO (IO (), Compile)
forall gv. Env => gv -> Version -> MaybeT IO (IO (), Compile)
compileGlobal
, GhcVersion -> Version -> MaybeT IO (IO (), Compile)
forall (m :: * -> *).
(Env, MonadIO m) =>
GhcVersion -> Version -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb
]
dbs :: [PackageDbDir]
dbs ->
[ (((Version -> IO (IO (), Compile))
-> Version -> MaybeT IO (IO (), Compile))
-> (GhcVersion -> Version -> IO (IO (), Compile))
-> GhcVersion
-> Version
-> MaybeT IO (IO (), Compile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)(((Version -> IO (IO (), Compile))
-> Version -> MaybeT IO (IO (), Compile))
-> (GhcVersion -> Version -> IO (IO (), Compile))
-> GhcVersion
-> Version
-> MaybeT IO (IO (), Compile))
-> ((IO (IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (Version -> IO (IO (), Compile))
-> Version
-> MaybeT IO (IO (), Compile))
-> (IO (IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (GhcVersion -> Version -> IO (IO (), Compile))
-> GhcVersion
-> Version
-> MaybeT IO (IO (), Compile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IO (IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (Version -> IO (IO (), Compile))
-> Version
-> MaybeT IO (IO (), Compile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) IO (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([PackageDbDir] -> GhcVersion -> Version -> IO (IO (), Compile)
forall (m :: * -> *) (f :: * -> *) p.
(Monad m, Applicative f) =>
[PackageDbDir] -> p -> Version -> m (f (), Compile)
compilePkgDbs [PackageDbDir]
dbs)
]
FilePath
appdir <- IO FilePath
appCacheDir
let cp :: CompPaths
cp@CompPaths {FilePath
compExePath :: FilePath
compExePath :: CompPaths -> FilePath
compExePath} = FilePath -> FilePath -> Compile -> CompPaths
compPaths FilePath
appdir FilePath
cheProjLocalCacheDir Compile
comp
Bool
helper_exists <- FilePath -> IO Bool
doesFileExist FilePath
compExePath
Either ExitCode FilePath
rv <- if Bool
helper_exists
then do
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "helper already compiled, using exe: "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
compExePath
Either ExitCode FilePath -> IO (Either ExitCode FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either ExitCode FilePath
forall a b. b -> Either a b
Right FilePath
compExePath)
else do
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "helper exe does not exist, compiling "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
compExePath
IO ()
prepare IO ()
-> IO (Either ExitCode FilePath) -> IO (Either ExitCode FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Env => CompPaths -> Compile -> IO (Either ExitCode FilePath)
CompPaths -> Compile -> IO (Either ExitCode FilePath)
compile CompPaths
cp Compile
comp
Either ExitCode FilePath -> IO (Either ExitCode FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Either ExitCode FilePath
rv
where
logMsg :: FilePath
logMsg = "using helper compiled with Cabal from "
compilePkgDbs :: [PackageDbDir] -> p -> Version -> m (f (), Compile)
compilePkgDbs dbs :: [PackageDbDir]
dbs _ghcVer :: p
_ghcVer cabalVer :: Version
cabalVer = (f (), Compile) -> m (f (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((f (), Compile) -> m (f (), Compile))
-> (f (), Compile) -> m (f (), Compile)
forall a b. (a -> b) -> a -> b
$
(,)
(() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
$WCompileWithCabalPackage :: GhcPackageSource
-> ResolvedCabalVersion -> CompilationProductScope -> Compile
CompileWithCabalPackage
{ compPackageSource :: GhcPackageSource
compPackageSource = [PackageDbDir] -> GhcPackageSource
GPSPackageDBs [PackageDbDir]
dbs
, compCabalVersion :: ResolvedCabalVersion
compCabalVersion = Version -> ResolvedCabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
cabalVer
, compProductTarget :: CompilationProductScope
compProductTarget = CompilationProductScope
CPSProject
}
compileGlobal :: Env => gv -> Version -> MaybeT IO (IO (), Compile)
compileGlobal :: gv -> Version -> MaybeT IO (IO (), Compile)
compileGlobal _ghcVer :: gv
_ghcVer cabalVer :: Version
cabalVer = do
[Version]
cabal_versions <- (Verbose, Progs) => Maybe PackageDbDir -> MaybeT IO [Version]
Maybe PackageDbDir -> MaybeT IO [Version]
listCabalVersions Maybe PackageDbDir
forall a. Maybe a
Nothing
Version
_ <- IO (Maybe Version) -> MaybeT IO Version
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Version) -> MaybeT IO Version)
-> IO (Maybe Version) -> MaybeT IO Version
forall a b. (a -> b) -> a -> b
$ Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Version -> Bool) -> [Version] -> Maybe Version
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
cabalVer) [Version]
cabal_versions
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
logMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "user/global package-db"
(IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), GhcPackageSource -> Version -> CompilationProductScope -> Compile
compileWithPkg GhcPackageSource
GPSAmbient Version
cabalVer CompilationProductScope
CPSGlobal)
compileSandbox :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileSandbox :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileSandbox ghcVer :: GhcVersion
ghcVer cabalVer :: Version
cabalVer = do
let mdb_path :: IO (Maybe FilePath)
mdb_path = FilePath -> GhcVersion -> FilePath -> IO (Maybe FilePath)
getSandboxPkgDb (Platform -> FilePath
forall a. Pretty a => a -> FilePath
display Platform
buildPlatform) GhcVersion
ghcVer FilePath
cheProjDir
PackageDbDir
sandbox <- FilePath -> PackageDbDir
PackageDbDir (FilePath -> PackageDbDir)
-> MaybeT IO FilePath -> MaybeT IO PackageDbDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath) -> MaybeT IO FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT IO (Maybe FilePath)
mdb_path
[Version]
cabal_versions <- (Verbose, Progs) => Maybe PackageDbDir -> MaybeT IO [Version]
Maybe PackageDbDir -> MaybeT IO [Version]
listCabalVersions (PackageDbDir -> Maybe PackageDbDir
forall a. a -> Maybe a
Just PackageDbDir
sandbox)
Version
_ <- IO (Maybe Version) -> MaybeT IO Version
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Version) -> MaybeT IO Version)
-> IO (Maybe Version) -> MaybeT IO Version
forall a b. (a -> b) -> a -> b
$ Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Version -> Bool) -> [Version] -> Maybe Version
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
cabalVer) [Version]
cabal_versions
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
logMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "sandbox package-db"
(IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), GhcPackageSource -> Version -> CompilationProductScope -> Compile
compileWithPkg ([PackageDbDir] -> GhcPackageSource
GPSPackageDBs [PackageDbDir
sandbox]) Version
cabalVer CompilationProductScope
CPSProject)
compileWithCabalV2Inplace :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2Inplace :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2Inplace ghcVer :: GhcVersion
ghcVer cabalVer :: Version
cabalVer = do
Map UnitId Unit
pjUnits <- MaybeT IO (Map UnitId Unit)
-> (Map UnitId Unit -> MaybeT IO (Map UnitId Unit))
-> Maybe (Map UnitId Unit)
-> MaybeT IO (Map UnitId Unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaybeT IO (Map UnitId Unit)
forall (m :: * -> *) a. MonadPlus m => m a
mzero Map UnitId Unit -> MaybeT IO (Map UnitId Unit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Map UnitId Unit)
chePjUnits
FilePath
distdir_newstyle <- MaybeT IO FilePath
-> (FilePath -> MaybeT IO FilePath)
-> Maybe FilePath
-> MaybeT IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaybeT IO FilePath
forall (m :: * -> *) a. MonadPlus m => m a
mzero FilePath -> MaybeT IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
cheDistV2
let cabal_pkgid :: PkgId
cabal_pkgid =
PkgName -> Ver -> PkgId
PkgId (Text -> PkgName
PkgName (FilePath -> Text
Text.pack "Cabal")) ([Int] -> Ver
Ver ([Int] -> Ver) -> [Int] -> Ver
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
cabalVer)
mcabal_unit :: Maybe Unit
mcabal_unit = [Unit] -> Maybe Unit
forall a. [a] -> Maybe a
listToMaybe ([Unit] -> Maybe Unit) -> [Unit] -> Maybe Unit
forall a b. (a -> b) -> a -> b
$
Map UnitId Unit -> [Unit]
forall k a. Map k a -> [a]
Map.elems (Map UnitId Unit -> [Unit]) -> Map UnitId Unit -> [Unit]
forall a b. (a -> b) -> a -> b
$ (Unit -> Bool) -> Map UnitId Unit -> Map UnitId Unit
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\CP.Unit{..} -> PkgId
uPId PkgId -> PkgId -> Bool
forall a. Eq a => a -> a -> Bool
== PkgId
cabal_pkgid) Map UnitId Unit
pjUnits
CP.Unit {} <- MaybeT IO Unit
-> (Unit -> MaybeT IO Unit) -> Maybe Unit -> MaybeT IO Unit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaybeT IO Unit
forall (m :: * -> *) a. MonadPlus m => m a
mzero Unit -> MaybeT IO Unit
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Unit
mcabal_unit
let inplace_db_path :: FilePath
inplace_db_path = FilePath
distdir_newstyle
FilePath -> FilePath -> FilePath
</> "packagedb" FilePath -> FilePath -> FilePath
</> ("ghc-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ GhcVersion -> FilePath
showGhcVersion GhcVersion
ghcVer)
inplace_db :: PackageDbDir
inplace_db = FilePath -> PackageDbDir
PackageDbDir FilePath
inplace_db_path
[Version]
cabal_versions <- (Verbose, Progs) => Maybe PackageDbDir -> MaybeT IO [Version]
Maybe PackageDbDir -> MaybeT IO [Version]
listCabalVersions (PackageDbDir -> Maybe PackageDbDir
forall a. a -> Maybe a
Just PackageDbDir
inplace_db)
Version
_ <- IO (Maybe Version) -> MaybeT IO Version
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Version) -> MaybeT IO Version)
-> IO (Maybe Version) -> MaybeT IO Version
forall a b. (a -> b) -> a -> b
$ Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Version -> Bool) -> [Version] -> Maybe Version
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
cabalVer) [Version]
cabal_versions
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
logMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "v2-build package-db " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
inplace_db_path
(IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), GhcPackageSource -> Version -> CompilationProductScope -> Compile
compileWithPkg ([PackageDbDir] -> GhcPackageSource
GPSPackageDBs [PackageDbDir
inplace_db]) Version
cabalVer CompilationProductScope
CPSProject)
compileWithCabalV2GhcEnv :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv ghcVer :: GhcVersion
ghcVer cabalVer :: Version
cabalVer =
Env =>
GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv' GhcVersion
ghcVer (Version -> UnpackedCabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
cabalVer)
compileWithCabalV2GhcEnv' :: Env => GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv' :: GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv' ghcVer :: GhcVersion
ghcVer cabalVer :: UnpackedCabalVersion
cabalVer = do
FilePath
_ <- MaybeT IO FilePath
-> (FilePath -> MaybeT IO FilePath)
-> Maybe FilePath
-> MaybeT IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MaybeT IO FilePath
forall (m :: * -> *) a. MonadPlus m => m a
mzero FilePath -> MaybeT IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
cheDistV2
CabalInstallVersion instVer :: Version
instVer <- IO CabalInstallVersion -> MaybeT IO CabalInstallVersion
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CabalInstallVersion
(Verbose, Progs) => IO CabalInstallVersion
cabalInstallVersion
Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Version
instVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= ([Int] -> [FilePath] -> Version
Version [2,4,1,0] [])
Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ GhcVersion
ghcVer GhcVersion -> GhcVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= (Version -> GhcVersion
GhcVersion ([Int] -> [FilePath] -> Version
Version [8,0] []))
env :: PackageEnvFile
env@(PackageEnvFile env_file :: FilePath
env_file) <- IO PackageEnvFile -> MaybeT IO PackageEnvFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PackageEnvFile -> MaybeT IO PackageEnvFile)
-> IO PackageEnvFile -> MaybeT IO PackageEnvFile
forall a b. (a -> b) -> a -> b
$
Verbose => GhcVersion -> ResolvedCabalVersion -> IO PackageEnvFile
GhcVersion -> ResolvedCabalVersion -> IO PackageEnvFile
getPrivateCabalPkgEnv GhcVersion
ghcVer (ResolvedCabalVersion -> IO PackageEnvFile)
-> ResolvedCabalVersion -> IO PackageEnvFile
forall a b. (a -> b) -> a -> b
$ UnpackedCabalVersion -> ResolvedCabalVersion
unpackedToResolvedCabalVersion UnpackedCabalVersion
cabalVer
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
logMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "v2-build package-env " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
env_file
(IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (,)
(PackageEnvFile -> IO ()
prepare PackageEnvFile
env)
$WCompileWithCabalPackage :: GhcPackageSource
-> ResolvedCabalVersion -> CompilationProductScope -> Compile
CompileWithCabalPackage
{ compPackageSource :: GhcPackageSource
compPackageSource = PackageEnvFile -> GhcPackageSource
GPSPackageEnv PackageEnvFile
env
, compCabalVersion :: ResolvedCabalVersion
compCabalVersion = UnpackedCabalVersion -> ResolvedCabalVersion
unpackedToResolvedCabalVersion UnpackedCabalVersion
cabalVer
, compProductTarget :: CompilationProductScope
compProductTarget = CompilationProductScope
CPSGlobal
}
where
prepare :: PackageEnvFile -> IO ()
prepare env :: PackageEnvFile
env = do
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Env =>
GhcVersion -> UnpackedCabalVersion -> PackageEnvFile -> IO ()
GhcVersion -> UnpackedCabalVersion -> PackageEnvFile -> IO ()
installCabalLibV2 GhcVersion
ghcVer UnpackedCabalVersion
cheCabalVer PackageEnvFile
env IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
\(IOError
ex :: IOError) -> IOError -> IO ()
forall a. Show a => a -> IO ()
print IOError
ex IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
case UnpackedCabalVersion
cheCabalVer of
CabalHEAD _ -> FilePath -> IO ()
forall a. FilePath -> IO a
panicIO "Installing Cabal HEAD failed."
CabalVersion ver :: Version
ver -> CabalVersion' Any -> IO ()
forall a b. CabalVersion' a -> IO b
errorInstallCabal (Version -> CabalVersion' Any
forall a. Version -> CabalVersion' a
CabalVersion Version
ver)
compileWithCabalInPrivatePkgDb
:: (Env, MonadIO m) => GhcVersion -> Version -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb :: GhcVersion -> Version -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb ghcVer :: GhcVersion
ghcVer cabalVer :: Version
cabalVer =
GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
forall (m :: * -> *).
(Env, MonadIO m) =>
GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb' GhcVersion
ghcVer (Version -> UnpackedCabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
cabalVer)
compileWithCabalInPrivatePkgDb'
:: (Env, MonadIO m) => GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb' :: GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb' ghcVer :: GhcVersion
ghcVer cabalVer :: UnpackedCabalVersion
cabalVer = do
db :: PackageDbDir
db@(PackageDbDir db_path :: FilePath
db_path) <- IO PackageDbDir -> m PackageDbDir
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PackageDbDir -> m PackageDbDir)
-> IO PackageDbDir -> m PackageDbDir
forall a b. (a -> b) -> a -> b
$
(Verbose, Progs) => ResolvedCabalVersion -> IO PackageDbDir
ResolvedCabalVersion -> IO PackageDbDir
getPrivateCabalPkgDb (ResolvedCabalVersion -> IO PackageDbDir)
-> ResolvedCabalVersion -> IO PackageDbDir
forall a b. (a -> b) -> a -> b
$ UnpackedCabalVersion -> ResolvedCabalVersion
unpackedToResolvedCabalVersion UnpackedCabalVersion
cabalVer
FilePath -> m ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
logMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "private package-db in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
db_path
(IO (), Compile) -> m (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> m (IO (), Compile))
-> (IO (), Compile) -> m (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (,)
(PackageDbDir -> IO ()
prepare PackageDbDir
db)
$WCompileWithCabalPackage :: GhcPackageSource
-> ResolvedCabalVersion -> CompilationProductScope -> Compile
CompileWithCabalPackage
{ compPackageSource :: GhcPackageSource
compPackageSource = [PackageDbDir] -> GhcPackageSource
GPSPackageDBs [PackageDbDir
db]
, compCabalVersion :: ResolvedCabalVersion
compCabalVersion = UnpackedCabalVersion -> ResolvedCabalVersion
unpackedToResolvedCabalVersion UnpackedCabalVersion
cabalVer
, compProductTarget :: CompilationProductScope
compProductTarget = CompilationProductScope
CPSGlobal
}
where
prepare :: PackageDbDir -> IO ()
prepare db :: PackageDbDir
db = do
Bool
db_exists <- IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ UnpackedCabalVersion -> PackageDbDir -> IO Bool
forall a.
(Verbose, Progs) =>
CabalVersion' a -> PackageDbDir -> IO Bool
cabalVersionExistsInPkgDb UnpackedCabalVersion
cabalVer PackageDbDir
db
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
db_exists) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO PackageDbDir -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Env => GhcVersion -> UnpackedCabalVersion -> IO PackageDbDir
GhcVersion -> UnpackedCabalVersion -> IO PackageDbDir
installCabalLibV1 GhcVersion
ghcVer UnpackedCabalVersion
cabalVer) IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
\(SomeException _) -> UnpackedCabalVersion -> IO ()
forall a b. CabalVersion' a -> IO b
errorInstallCabal UnpackedCabalVersion
cabalVer
compileCabalSource :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileCabalSource _ghcVer :: GhcVersion
_ghcVer _cabalVer :: Version
_cabalVer = do
let cabalFile :: FilePath
cabalFile = FilePath
cheProjDir FilePath -> FilePath -> FilePath
</> "Cabal.cabal"
Bool
cabalSrc <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
cabalFile
let projdir :: CabalSourceDir
projdir = FilePath -> CabalSourceDir
CabalSourceDir FilePath
cheProjDir
case Bool
cabalSrc of
False -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
True -> do
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ "projdir looks like Cabal source tree (Cabal.cabal exists)"
FilePath
cf <- IO FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> MaybeT IO FilePath)
-> IO FilePath -> MaybeT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
cabalFile
let buildType :: FilePath
buildType = FilePath -> FilePath
cabalFileBuildType FilePath
cf
ver :: Version
ver = FilePath -> Version
cabalFileVersion FilePath
cf
case FilePath
buildType of
"simple" -> do
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ "Cabal source tree is build-type:simple, moving on"
MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
"custom" -> do
FilePath -> MaybeT IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> MaybeT IO ()) -> FilePath -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ "compiling helper with local Cabal source tree"
(IO (), Compile) -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IO (), Compile) -> MaybeT IO (IO (), Compile))
-> (IO (), Compile) -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), CabalSourceDir -> Version -> Compile
compileWithCabalSource CabalSourceDir
projdir Version
ver)
_ -> FilePath -> MaybeT IO (IO (), Compile)
forall a. HasCallStack => FilePath -> a
error (FilePath -> MaybeT IO (IO (), Compile))
-> FilePath -> MaybeT IO (IO (), Compile)
forall a b. (a -> b) -> a -> b
$ "compileCabalSource: unknown build-type: '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
buildTypeFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++"'"
compileWithCabalSource :: CabalSourceDir -> Version -> Compile
compileWithCabalSource srcDir :: CabalSourceDir
srcDir ver :: Version
ver =
$WCompileWithCabalSource :: CabalSourceDir -> Version -> Compile
CompileWithCabalSource
{ compCabalSourceDir :: CabalSourceDir
compCabalSourceDir = CabalSourceDir
srcDir
, compCabalSourceVersion :: Version
compCabalSourceVersion = Version
ver
}
compileWithPkg :: GhcPackageSource -> Version -> CompilationProductScope -> Compile
compileWithPkg pkg_src :: GhcPackageSource
pkg_src ver :: Version
ver target :: CompilationProductScope
target =
$WCompileWithCabalPackage :: GhcPackageSource
-> ResolvedCabalVersion -> CompilationProductScope -> Compile
CompileWithCabalPackage
{ compPackageSource :: GhcPackageSource
compPackageSource = GhcPackageSource
pkg_src
, compCabalVersion :: ResolvedCabalVersion
compCabalVersion = Version -> ResolvedCabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
ver
, compProductTarget :: CompilationProductScope
compProductTarget = CompilationProductScope
target
}
compile :: Env => CompPaths -> Compile -> IO (Either ExitCode FilePath)
compile :: CompPaths -> Compile -> IO (Either ExitCode FilePath)
compile paths :: CompPaths
paths@CompPaths {..} comp :: Compile
comp = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
compOutDir
FilePath -> IO ()
createHelperSources FilePath
compBuildDir
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "compBuildDir: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
compBuildDir
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "compOutDir: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
compOutDir
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "compExePath: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
compExePath
Env => GhcInvocation -> IO (Either ExitCode FilePath)
GhcInvocation -> IO (Either ExitCode FilePath)
invokeGhc (GhcInvocation -> IO (Either ExitCode FilePath))
-> GhcInvocation -> IO (Either ExitCode FilePath)
forall a b. (a -> b) -> a -> b
$ Compile -> CompPaths -> GhcInvocation
compGhcInvocation Compile
comp CompPaths
paths
compPaths :: FilePath -> FilePath -> Compile -> CompPaths
compPaths :: FilePath -> FilePath -> Compile -> CompPaths
compPaths appdir :: FilePath
appdir proj_local_cachedir :: FilePath
proj_local_cachedir c :: Compile
c =
case Compile
c of
CompileWithCabalPackage
{ compProductTarget :: Compile -> CompilationProductScope
compProductTarget=CompilationProductScope
CPSGlobal
, ResolvedCabalVersion
compCabalVersion :: ResolvedCabalVersion
compCabalVersion :: Compile -> ResolvedCabalVersion
compCabalVersion
} -> $WCompPaths :: FilePath -> FilePath -> FilePath -> CompPaths
CompPaths {..}
where
compBuildDir :: FilePath
compBuildDir =
FilePath
appdir FilePath -> FilePath -> FilePath
</> ResolvedCabalVersion -> FilePath
exeName ResolvedCabalVersion
compCabalVersion FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "--" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sourceHash FilePath -> FilePath -> FilePath
<.> "build"
compOutDir :: FilePath
compOutDir = FilePath
compBuildDir
compExePath :: FilePath
compExePath = FilePath
compBuildDir FilePath -> FilePath -> FilePath
</> "cabal-helper"
CompileWithCabalPackage {compProductTarget :: Compile -> CompilationProductScope
compProductTarget=CompilationProductScope
CPSProject} ->
CompPaths
projLocalCachedirPaths
CompileWithCabalSource {} ->
CompPaths
projLocalCachedirPaths
where
projLocalCachedirPaths :: CompPaths
projLocalCachedirPaths = $WCompPaths :: FilePath -> FilePath -> FilePath -> CompPaths
CompPaths {..}
where
compBuildDir :: FilePath
compBuildDir = FilePath
proj_local_cachedir FilePath -> FilePath -> FilePath
</> "cabal-helper"
compOutDir :: FilePath
compOutDir = FilePath
compBuildDir
compExePath :: FilePath
compExePath = FilePath
compOutDir FilePath -> FilePath -> FilePath
</> "cabal-helper"
exeName :: ResolvedCabalVersion -> String
exeName :: ResolvedCabalVersion -> FilePath
exeName (CabalHEAD commitid :: CommitId
commitid) = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "--"
[ "cabal-helper-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version
, "Cabal-HEAD" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CommitId -> FilePath
unCommitId CommitId
commitid
]
exeName CabalVersion {Version
cvVersion :: forall a. CabalVersion' a -> Version
cvVersion :: Version
cvVersion} = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "--"
[ "cabal-helper-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version
, "Cabal-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
cvVersion
]
compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
compGhcInvocation comp :: Compile
comp CompPaths {..} =
case Compile
comp of
CompileWithCabalSource {..} ->
$WGhcInvocation :: FilePath
-> FilePath
-> [FilePath]
-> GhcPackageSource
-> [FilePath]
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> GhcInvocation
GhcInvocation
{ giIncludeDirs :: [FilePath]
giIncludeDirs = [FilePath
compBuildDir, CabalSourceDir -> FilePath
unCabalSourceDir CabalSourceDir
compCabalSourceDir]
, giPackageSource :: GhcPackageSource
giPackageSource = GhcPackageSource
GPSAmbient
, giHideAllPackages :: Bool
giHideAllPackages = Bool
False
, giPackages :: [FilePath]
giPackages = []
, giCPPOptions :: [FilePath]
giCPPOptions = Version -> [FilePath]
cppOptions Version
compCabalSourceVersion
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [Version -> FilePath
cabalVersionMacro Version
compCabalSourceVersion]
, ..
}
CompileWithCabalPackage {..} ->
$WGhcInvocation :: FilePath
-> FilePath
-> [FilePath]
-> GhcPackageSource
-> [FilePath]
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> GhcInvocation
GhcInvocation
{ giIncludeDirs :: [FilePath]
giIncludeDirs = [FilePath
compBuildDir]
, giPackageSource :: GhcPackageSource
giPackageSource = GhcPackageSource
compPackageSource
, giHideAllPackages :: Bool
giHideAllPackages = Bool
True
, giPackages :: [FilePath]
giPackages =
[ "base"
, "containers"
, "directory"
, "filepath"
, "process"
, "bytestring"
, "ghc-prim"
, case ResolvedCabalVersion
compCabalVersion of
CabalHEAD {} -> "Cabal"
CabalVersion ver :: Version
ver -> "Cabal-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
ver
]
, giCPPOptions :: [FilePath]
giCPPOptions = Version -> [FilePath]
cppOptions (ResolvedCabalVersion -> Version
forall a. CabalVersion' a -> Version
unCabalVersion ResolvedCabalVersion
compCabalVersion)
, ..
}
where
unCabalVersion :: CabalVersion' a -> Version
unCabalVersion (CabalVersion ver :: Version
ver) = Version
ver
unCabalVersion (CabalHEAD _) = [Int] -> [FilePath] -> Version
Version [10000000, 0, 0] []
cppOptions :: Version -> [FilePath]
cppOptions cabalVer :: Version
cabalVer =
[ "-DCABAL_HELPER=1"
, Version -> FilePath
cabalMinVersionMacro Version
cabalVer
]
giOutDir :: FilePath
giOutDir = FilePath
compOutDir
giOutput :: FilePath
giOutput = FilePath
compExePath
giWarningFlags :: [FilePath]
giWarningFlags = [ "-w" ]
giInputs :: [FilePath]
giInputs = [FilePath
compBuildDirFilePath -> FilePath -> FilePath
</>"CabalHelper"FilePath -> FilePath -> FilePath
</>"Runtime"FilePath -> FilePath -> FilePath
</>"Main.hs"]
cabalVersionMacro :: Version -> String
cabalVersionMacro :: Version -> FilePath
cabalVersionMacro (Version vs :: [Int]
vs _) =
"-DCABAL_VERSION="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "," ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int]
vs)
cabalMinVersionMacro :: Version -> String
cabalMinVersionMacro :: Version -> FilePath
cabalMinVersionMacro (Version (mj1 :: Int
mj1:mj2 :: Int
mj2:mi :: Int
mi:_) _) =
"-DCH_MIN_VERSION_Cabal(major1,major2,minor)=\
\( (major1) < "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mj1FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++" \
\|| (major1) == "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mj1FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++" && (major2) < "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mj2FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++" \
\|| (major1) == "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mj1FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++" && (major2) == "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mj2FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++" && (minor) <= "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Int -> FilePath
forall a. Show a => a -> FilePath
show Int
miFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
")"
cabalMinVersionMacro _ =
FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error "cabalMinVersionMacro: Version must have at least 3 components"
errorInstallCabal :: CabalVersion' a -> IO b
errorInstallCabal :: CabalVersion' a -> IO b
errorInstallCabal (CabalHEAD _) =
FilePath -> IO b
forall a. HasCallStack => FilePath -> a
error "cabal-helper: Installing Cabal HEAD failed."
errorInstallCabal (CabalVersion cabalVer :: Version
cabalVer) = FilePath -> IO b
forall a. FilePath -> IO a
panicIO (FilePath -> IO b) -> FilePath -> IO b
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf "\
\cabal-helper: Installing Cabal version %s failed.\n\
\\n\
\You have the following choices to fix this:\n\
\\n\
\- The easiest way to try and fix this is just reconfigure the project and try\n\
\ again:\n\
\ $ cabal clean && cabal configure\n\
\\n\
\- If that fails you can try to install the version of Cabal mentioned above\n\
\ into your global/user package-db somehow, though you'll probably have to\n\
\ fix something otherwise it wouldn't have failed above:\n\
\ $ cabal install Cabal --constraint 'Cabal == %s'\n\
\\n\
\- If you're using `Build-Type: Simple`:\n\
\ - You can see if you can reinstall your cabal-install executable while\n\
\ having it linked to a version of Cabal that's available in you\n\
\ package-dbs or can be built automatically:\n\
\ $ ghc-pkg list | grep Cabal # find an available Cabal version\n\
\ Cabal-W.X.Y.Z\n\
\ $ cabal install cabal-install --constraint 'Cabal == W.X.*'\n\
\ Afterwards you'll have to reconfigure your project:\n\
\ $ cabal clean && cabal configure\n\
\\n\
\- If you're using `Build-Type: Custom`:\n\
\ - Have cabal-install rebuild your Setup.hs executable with a version of the\n\
\ Cabal library that you have available in your global/user package-db:\n\
\ $ cabal clean && cabal configure\n\
\ You might also have to install some version of the Cabal to do this:\n\
\ $ cabal install Cabal\n\
\\n" FilePath
sver FilePath
sver
where
sver :: FilePath
sver = Version -> FilePath
showVersion Version
cabalVer
cabalFileVersion :: String -> Version
cabalFileVersion :: FilePath -> Version
cabalFileVersion = FilePath -> Version
parseVer (FilePath -> Version)
-> (FilePath -> FilePath) -> FilePath -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
cabalFileTopField "version"
cabalFileBuildType :: String -> String
cabalFileBuildType :: FilePath -> FilePath
cabalFileBuildType = FilePath -> FilePath -> FilePath
cabalFileTopField "build-type"
cabalFileTopField :: String -> String -> String
cabalFileTopField :: FilePath -> FilePath -> FilePath
cabalFileTopField field :: FilePath
field cabalFile :: FilePath
cabalFile = FilePath
value
where
Just value :: FilePath
value = FilePath -> FilePath
extract (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FilePath
fieldFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++":") FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [FilePath]
ls
ls :: [FilePath]
ls = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
cabalFile
extract :: FilePath -> FilePath
extract = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=':') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)