-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2015-2018  Daniel Gröber <cabal-helper@dxld.at>
--
-- SPDX-License-Identifier: Apache-2.0
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0

{-# LANGUAGE DeriveFunctor, GADTs, ScopedTypeVariables #-}

{-|
Module      : CabalHelper.Compiletime.Compile
Description : Runtime compilation machinery
License     : Apache-2.0
-}

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
    }

-- | The Helper executable we produce as a compilation product can either be
-- placed in a per-project location, or a per-user/global location in the user's
-- home directory. This type controls where the compilation process places the
-- executable.
data CompilationProductScope = CPSGlobal | CPSProject

type CompHelperEnv = CompHelperEnv' CabalVersion
data CompHelperEnv' cv = CompHelperEnv
  { CompHelperEnv' cv -> cv
cheCabalVer :: !cv
  , CompHelperEnv' cv -> [PackageDbDir]
chePkgDb    :: ![PackageDbDir]
  -- ^ A package-db where we are guaranteed to find Cabal-`cheCabalVer`.
  , 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 FilePath
"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
$ \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 {FilePath
[PackageDbDir]
Maybe FilePath
Maybe (Map UnitId Unit)
UnpackedCabalVersion
cheProjLocalCacheDir :: FilePath
cheDistV2 :: Maybe FilePath
chePjUnits :: Maybe (Map UnitId Unit)
cheProjDir :: FilePath
chePkgDb :: [PackageDbDir]
cheCabalVer :: UnpackedCabalVersion
cheProjLocalCacheDir :: forall cv. CompHelperEnv' cv -> FilePath
cheDistV2 :: forall cv. CompHelperEnv' cv -> Maybe FilePath
chePjUnits :: forall cv. CompHelperEnv' cv -> Maybe (Map UnitId Unit)
cheProjDir :: forall cv. CompHelperEnv' cv -> FilePath
chePkgDb :: forall cv. CompHelperEnv' cv -> [PackageDbDir]
cheCabalVer :: forall cv. CompHelperEnv' cv -> cv
..} = do
  GhcVersion
ghcVer <- IO GhcVersion
(Verbose, Progs) => IO GhcVersion
ghcVersion
  Just (IO ()
prepare, 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 (\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 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 (\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
            ]
          [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
$ FilePath
"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
$ FilePath
"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 = FilePath
"using helper compiled with Cabal from "

-- for relaxed deps: find (sameMajorVersionAs cheCabalVer) . reverse . sort

   compilePkgDbs :: [PackageDbDir] -> p -> Version -> m (f (), Compile)
compilePkgDbs [PackageDbDir]
dbs p
_ghcVer 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 ())
         CompileWithCabalPackage :: 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
           }

   -- | Check if this version is globally available
   compileGlobal :: Env => gv -> Version -> MaybeT IO (IO (), Compile)
   compileGlobal :: gv -> Version -> MaybeT IO (IO (), Compile)
compileGlobal gv
_ghcVer 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]
++ FilePath
"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)

   -- | Check if this version is available in the project sandbox
   compileSandbox :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
   compileSandbox :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileSandbox  GhcVersion
ghcVer 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]
++ FilePath
"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)

   -- | Check if the requested Cabal version is available in a v2-build
   -- project's inplace package-db.
   --
   -- This is likely only the case if Cabal was vendored by this project or if
   -- we're operating on Cabal itself!
   compileWithCabalV2Inplace :: Env => GhcVersion -> Version -> MaybeT IO (IO (), Compile)
   compileWithCabalV2Inplace :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileWithCabalV2Inplace GhcVersion
ghcVer Version
cabalVer = do
       -- TODO: Test coverage! Neither compile-test nor ghc-session test out
       -- this code path
       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 FilePath
"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{Maybe FilePath
Maybe Sha256
Maybe PkgLoc
UnitId
PkgId
UnitType
Map FlagName Bool
Map CompName CompInfo
uId :: Unit -> UnitId
uType :: Unit -> UnitType
uSha256 :: Unit -> Maybe Sha256
uCabalSha256 :: Unit -> Maybe Sha256
uComps :: Unit -> Map CompName CompInfo
uFlags :: Unit -> Map FlagName Bool
uDistDir :: Unit -> Maybe FilePath
uPkgSrc :: Unit -> Maybe PkgLoc
uPkgSrc :: Maybe PkgLoc
uDistDir :: Maybe FilePath
uFlags :: Map FlagName Bool
uComps :: Map CompName CompInfo
uCabalSha256 :: Maybe Sha256
uSha256 :: Maybe Sha256
uType :: UnitType
uPId :: PkgId
uId :: UnitId
uPId :: Unit -> PkgId
..} -> 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
</> FilePath
"packagedb" FilePath -> 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]
++ FilePath
"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 GhcVersion
ghcVer 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)

   -- TODO: Support using existing ghc-environments too! That's mostly
   -- relevant for when you want to use a development version of
   -- cabal-install since that will depend on an unreleased version of
   -- Cabal we cannot new-install just like that.

   -- | If this is a v2-build project it makes sense to use @v2-install@ for
   -- installing Cabal as this will use the @~/.cabal/store@. We use
   -- @--package-env@ to instruct cabal to not meddle with the user's package
   -- environment.
   compileWithCabalV2GhcEnv' :: Env => GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
   compileWithCabalV2GhcEnv' :: GhcVersion -> UnpackedCabalVersion -> MaybeT IO (IO (), Compile)
compileWithCabalV2GhcEnv' GhcVersion
ghcVer 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 -- bail if this isn't a v2-build project
       CabalInstallVersion 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 [Int
2,Int
4,Int
1,Int
0] [])
       --  ^ didn't test with older versions
       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 [Int
8,Int
0] []))
       env :: PackageEnvFile
env@(PackageEnvFile 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]
++ FilePath
"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)
         CompileWithCabalPackage :: 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 PackageEnvFile
env = do
         -- exists_in_env <- liftIO $ cabalVersionExistsInPkgDb cheCabalVer db
         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 (CommitId, CabalSourceDir)
_ -> FilePath -> IO ()
forall a. FilePath -> IO a
panicIO FilePath
"Installing Cabal HEAD failed."
                 CabalVersion 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 GhcVersion
ghcVer 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)

   -- | Compile the requested Cabal version into an isolated package-db if it's
   -- not there already
   compileWithCabalInPrivatePkgDb'
       :: (Env, MonadIO m) => GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
   compileWithCabalInPrivatePkgDb' :: GhcVersion -> UnpackedCabalVersion -> m (IO (), Compile)
compileWithCabalInPrivatePkgDb' GhcVersion
ghcVer UnpackedCabalVersion
cabalVer = do
       db :: PackageDbDir
db@(PackageDbDir 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]
++ FilePath
"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)
         CompileWithCabalPackage :: 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 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 e
_) -> UnpackedCabalVersion -> IO ()
forall a b. CabalVersion' a -> IO b
errorInstallCabal UnpackedCabalVersion
cabalVer

   -- | See if we're in a cabal source tree
   --   compileCabalSource :: Env => MaybeT IO (IO (), Compile)
   compileCabalSource :: GhcVersion -> Version -> MaybeT IO (IO (), Compile)
compileCabalSource GhcVersion
_ghcVer Version
_cabalVer = do
       let cabalFile :: FilePath
cabalFile = FilePath
cheProjDir FilePath -> 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
         Bool
False -> MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
         Bool
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
$ FilePath
"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
             FilePath
"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
$ FilePath
"Cabal source tree is build-type:simple, moving on"
                 MaybeT IO (IO (), Compile)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
             FilePath
"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
$ FilePath
"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
_ -> 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
$ FilePath
"compileCabalSource: unknown build-type: '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
buildTypeFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

   compileWithCabalSource :: CabalSourceDir -> Version -> Compile
compileWithCabalSource CabalSourceDir
srcDir Version
ver =
       CompileWithCabalSource :: CabalSourceDir -> Version -> Compile
CompileWithCabalSource
          { compCabalSourceDir :: CabalSourceDir
compCabalSourceDir       = CabalSourceDir
srcDir
          , compCabalSourceVersion :: Version
compCabalSourceVersion   = Version
ver
          }

   compileWithPkg :: GhcPackageSource -> Version -> CompilationProductScope -> Compile
compileWithPkg GhcPackageSource
pkg_src Version
ver CompilationProductScope
target =
       CompileWithCabalPackage :: 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 {FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
compExePath :: CompPaths -> FilePath
compOutDir :: CompPaths -> FilePath
compBuildDir :: CompPaths -> FilePath
..} 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
$ FilePath
"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
$ FilePath
"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
$ FilePath
"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 FilePath
appdir FilePath
proj_local_cachedir Compile
c =
  case Compile
c of
    CompileWithCabalPackage
      { compProductTarget :: Compile -> CompilationProductScope
compProductTarget=CompilationProductScope
CPSGlobal
      , ResolvedCabalVersion
compCabalVersion :: ResolvedCabalVersion
compCabalVersion :: Compile -> ResolvedCabalVersion
compCabalVersion
      } -> CompPaths :: FilePath -> FilePath -> FilePath -> CompPaths
CompPaths {FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
..}
        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 -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
sourceHash FilePath -> FilePath -> FilePath
<.> FilePath
"build"
          compOutDir :: FilePath
compOutDir  = FilePath
compBuildDir
          compExePath :: FilePath
compExePath = FilePath
compBuildDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-helper"
    CompileWithCabalPackage {compProductTarget :: Compile -> CompilationProductScope
compProductTarget=CompilationProductScope
CPSProject} ->
        CompPaths
projLocalCachedirPaths
    CompileWithCabalSource {} ->
        CompPaths
projLocalCachedirPaths
  where
    projLocalCachedirPaths :: CompPaths
projLocalCachedirPaths = CompPaths :: FilePath -> FilePath -> FilePath -> CompPaths
CompPaths {FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
..}
        where
          compBuildDir :: FilePath
compBuildDir = FilePath
proj_local_cachedir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-helper"
          compOutDir :: FilePath
compOutDir  = FilePath
compBuildDir
          compExePath :: FilePath
compExePath = FilePath
compOutDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal-helper"

exeName :: ResolvedCabalVersion -> String
exeName :: ResolvedCabalVersion -> FilePath
exeName (CabalHEAD CommitId
commitid) = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"--"
  [ FilePath
"cabal-helper-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version
  , FilePath
"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 FilePath
"--"
  [ FilePath
"cabal-helper-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version
  , FilePath
"Cabal-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
cvVersion
  ]

compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
compGhcInvocation :: Compile -> CompPaths -> GhcInvocation
compGhcInvocation Compile
comp CompPaths {FilePath
compExePath :: FilePath
compOutDir :: FilePath
compBuildDir :: FilePath
compExePath :: CompPaths -> FilePath
compOutDir :: CompPaths -> FilePath
compBuildDir :: CompPaths -> FilePath
..} =
    case Compile
comp of
      CompileWithCabalSource {Version
CabalSourceDir
compCabalSourceVersion :: Version
compCabalSourceDir :: CabalSourceDir
compCabalSourceVersion :: Compile -> Version
compCabalSourceDir :: Compile -> CabalSourceDir
..} ->
        GhcInvocation :: 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]
          , FilePath
[FilePath]
giInputs :: [FilePath]
giWarningFlags :: [FilePath]
giOutput :: FilePath
giOutDir :: FilePath
giInputs :: [FilePath]
giWarningFlags :: [FilePath]
giOutput :: FilePath
giOutDir :: FilePath
..
          }
      CompileWithCabalPackage {ResolvedCabalVersion
GhcPackageSource
CompilationProductScope
compProductTarget :: CompilationProductScope
compCabalVersion :: ResolvedCabalVersion
compPackageSource :: GhcPackageSource
compProductTarget :: Compile -> CompilationProductScope
compCabalVersion :: Compile -> ResolvedCabalVersion
compPackageSource :: Compile -> GhcPackageSource
..} ->
        GhcInvocation :: 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 =
              [ FilePath
"base"
              , FilePath
"containers"
              , FilePath
"directory"
              , FilePath
"filepath"
              , FilePath
"process"
              , FilePath
"bytestring"
              , FilePath
"ghc-prim"
              , case ResolvedCabalVersion
compCabalVersion of
                  CabalHEAD {} -> FilePath
"Cabal"
                  CabalVersion Version
ver -> FilePath
"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)
          , FilePath
[FilePath]
giInputs :: [FilePath]
giWarningFlags :: [FilePath]
giOutput :: FilePath
giOutDir :: FilePath
giInputs :: [FilePath]
giWarningFlags :: [FilePath]
giOutput :: FilePath
giOutDir :: FilePath
..
          }
  where

    unCabalVersion :: CabalVersion' a -> Version
unCabalVersion (CabalVersion Version
ver) = Version
ver
    unCabalVersion (CabalHEAD a
_)      = [Int] -> [FilePath] -> Version
Version [Int
10000000, Int
0, Int
0] []

    cppOptions :: Version -> [FilePath]
cppOptions Version
cabalVer =
        [ FilePath
"-DCABAL_HELPER=1"
        , Version -> FilePath
cabalMinVersionMacro Version
cabalVer
        ]

    giOutDir :: FilePath
giOutDir = FilePath
compOutDir
    giOutput :: FilePath
giOutput = FilePath
compExePath
    giWarningFlags :: [FilePath]
giWarningFlags = [ FilePath
"-w" ] -- no point in bothering end users with warnings
    giInputs :: [FilePath]
giInputs = [FilePath
compBuildDirFilePath -> FilePath -> FilePath
</>FilePath
"CabalHelper"FilePath -> FilePath -> FilePath
</>FilePath
"Runtime"FilePath -> FilePath -> FilePath
</>FilePath
"Main.hs"]

cabalVersionMacro :: Version -> String
cabalVersionMacro :: Version -> FilePath
cabalVersionMacro (Version [Int]
vs [FilePath]
_) =
  FilePath
"-DCABAL_VERSION="FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," ((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 (Int
mj1:Int
mj2:Int
mi:[Int]
_) [FilePath]
_) =
  FilePath
"-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]
++FilePath
" \
  \|| (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]
++FilePath
" && (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]
++FilePath
" \
  \|| (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]
++FilePath
" && (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]
++FilePath
" && (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]
++
  FilePath
")"
cabalMinVersionMacro Version
_ =
    FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"cabalMinVersionMacro: Version must have at least 3 components"

{-
TODO: If the Cabal version we want to install is less than or equal to one we
have available, either through act-as-setup or in a package-db we should be able
to use act-as-setup or build a default Setup.hs exe and patch the Cabal source
to say build-type:simple. This will sidestep bugs in c-i>=1.24

See conversation in
https://github.com/haskell/cabal/commit/e2bf243300957321497353a2f85517e464f764ab

Otherwise we might be able to use the shipped Setup.hs

-}

errorInstallCabal :: CabalVersion' a -> IO b
errorInstallCabal :: CabalVersion' a -> IO b
errorInstallCabal (CabalHEAD a
_) =
  FilePath -> IO b
forall a. HasCallStack => FilePath -> a
error FilePath
"cabal-helper: Installing Cabal HEAD failed."
errorInstallCabal (CabalVersion 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 FilePath
"\
\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

-- | Find @version: XXX@ delcaration in a cabal file
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 FilePath
"version"

-- | Find @build-type: XXX@ delcaration in a cabal file
cabalFileBuildType :: String -> String
cabalFileBuildType :: FilePath -> FilePath
cabalFileBuildType = FilePath -> FilePath -> FilePath
cabalFileTopField FilePath
"build-type"

cabalFileTopField :: String -> String -> String
cabalFileTopField :: FilePath -> FilePath -> FilePath
cabalFileTopField FilePath
field FilePath
cabalFile = FilePath
value
 where
  Just 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 -> 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
/=Char
':') (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 Int
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)