{-# LANGUAGE RecordWildCards, FlexibleContexts, ConstraintKinds,
GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric, DeriveFunctor,
StandaloneDeriving, NamedFieldPuns, OverloadedStrings, ViewPatterns,
TupleSections, TypeFamilies, DataKinds, GADTs, ScopedTypeVariables,
ImplicitParams, RankNTypes, MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Distribution.Helper (
Query
, runQuery
, compilerVersion
, projectPackages
, Package
, pPackageName
, pSourceDir
, pUnits
, Unit
, uComponentName
, UnitId
, UnitInfo(..)
, unitInfo
, allUnits
, QueryEnv
, QueryEnvI
, mkQueryEnv
, qeReadProcess
, qeCallProcess
, qePrograms
, qeProjLoc
, qeDistDir
, ProjType(..)
, CabalProjType(..)
, ProjLoc(..)
, DistDir(..)
, SProjType(..)
, demoteSProjType
, projTypeOfDistDir
, projTypeOfProjLoc
, SCabalProjType(..)
, Ex(..)
, Programs(..)
, defaultPrograms
, EnvOverride(..)
, ChComponentInfo(..)
, ChComponentName(..)
, ChLibraryName(..)
, ChModuleName(..)
, ChPkgDb(..)
, ChEntrypoint(..)
, Distribution.Helper.buildPlatform
, Distribution.Helper.getSandboxPkgDb
, prepare
, writeAutogenFiles
, buildProject
, buildUnits
) where
import Cabal.Plan hiding (Unit, UnitId, uDistDir)
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Control.Exception as E
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.UTF8 as BSU
import Data.IORef
import Data.List hiding (filter)
import Data.String
import qualified Data.Text as Text
import Data.Maybe
import Data.Either
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Traversable as T
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Version
import Data.Function
import System.Clock as Clock
import System.IO
import System.Environment
import System.FilePath
import System.Directory
import System.Process
import System.Posix.Types
import System.PosixCompat.Files
import Text.Printf
import Text.Read
import Prelude
import CabalHelper.Compiletime.Compile
import qualified CabalHelper.Compiletime.Program.Stack as Stack
import qualified CabalHelper.Compiletime.Program.GHC as GHC
import qualified CabalHelper.Compiletime.Program.CabalInstall as CabalInstall
import CabalHelper.Compiletime.Cabal
import CabalHelper.Compiletime.CompPrograms
import CabalHelper.Compiletime.Log
import CabalHelper.Compiletime.Process
import CabalHelper.Compiletime.Sandbox
import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.Types.Cabal
import CabalHelper.Compiletime.Types.RelativePath
import CabalHelper.Shared.InterfaceTypes
import CabalHelper.Shared.Common
import CabalHelper.Runtime.HelperMain (helper_main)
import CabalHelper.Compiletime.Compat.Version
import Distribution.System (buildPlatform)
import Distribution.Text (display)
newtype Query pt a = Query
{ Query pt a -> QueryEnv pt -> IO a
unQuery :: QueryEnv pt -> IO a
}
instance Functor (Query pt) where
fmap :: (a -> b) -> Query pt a -> Query pt b
fmap = (a -> b) -> Query pt a -> Query pt b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (Query pt) where
<*> :: Query pt (a -> b) -> Query pt a -> Query pt b
(<*>) = Query pt (a -> b) -> Query pt a -> Query pt b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: a -> Query pt a
pure = a -> Query pt a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Monad (Query pt) where
(Query ma :: QueryEnv pt -> IO a
ma) >>= :: Query pt a -> (a -> Query pt b) -> Query pt b
>>= amb :: a -> Query pt b
amb = (QueryEnv pt -> IO b) -> Query pt b
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO b) -> Query pt b)
-> (QueryEnv pt -> IO b) -> Query pt b
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> QueryEnv pt -> IO a
ma QueryEnv pt
qe IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> Query pt b -> QueryEnv pt -> IO b
forall (pt :: ProjType) a. Query pt a -> QueryEnv pt -> IO a
unQuery (a -> Query pt b
amb a
a) QueryEnv pt
qe
return :: a -> Query pt a
return a :: a
a = (QueryEnv pt -> IO a) -> Query pt a
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO a) -> Query pt a)
-> (QueryEnv pt -> IO a) -> Query pt a
forall a b. (a -> b) -> a -> b
$ IO a -> QueryEnv pt -> IO a
forall a b. a -> b -> a
const (IO a -> QueryEnv pt -> IO a) -> IO a -> QueryEnv pt -> IO a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runQuery :: Query pt a -> QueryEnv pt -> IO a
runQuery :: Query pt a -> QueryEnv pt -> IO a
runQuery (Query action :: QueryEnv pt -> IO a
action) qe :: QueryEnv pt
qe = do
IORef (CacheKeyCache pt)
ckr <- CacheKeyCache pt -> IO (IORef (CacheKeyCache pt))
forall a. a -> IO (IORef a)
newIORef (CacheKeyCache pt -> IO (IORef (CacheKeyCache pt)))
-> CacheKeyCache pt -> IO (IORef (CacheKeyCache pt))
forall a b. (a -> b) -> a -> b
$ Maybe (ProjConf pt, ProjConfModTimes) -> CacheKeyCache pt
forall (pt :: ProjType).
Maybe (ProjConf pt, ProjConfModTimes) -> CacheKeyCache pt
CacheKeyCache Maybe (ProjConf pt, ProjConfModTimes)
forall a. Maybe a
Nothing
let qe' :: QueryEnv pt
qe' = QueryEnv pt
qe { qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheKeys = IORef (CacheKeyCache pt)
ckr }
Programs
conf_progs <- QueryEnv pt -> IO Programs
forall (a :: ProjType -> *) b (pt :: ProjType).
QueryEnvI (QCProgs a b) pt -> IO Programs
getConfProgs QueryEnv pt
qe'
QueryEnv pt -> IO a
action QueryEnv pt
qe' { qePrograms :: Programs
qePrograms = Programs
conf_progs }
mkQueryEnv
:: ProjLoc pt
-> DistDir pt
-> IO (QueryEnv pt)
mkQueryEnv :: ProjLoc pt -> DistDir pt -> IO (QueryEnv pt)
mkQueryEnv projloc :: ProjLoc pt
projloc distdir :: DistDir pt
distdir = do
IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
cr <- QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> IO (IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt))
forall a. a -> IO (IORef a)
newIORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> IO (IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)))
-> QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> IO (IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt))
forall a b. (a -> b) -> a -> b
$ Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
-> Maybe (Programs, Programs)
-> Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
-> Map DistDirLib UnitInfo
-> QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
Maybe ((ProjConf pt, ProjConfModTimes), pre_info pt)
-> Maybe (Programs, progs)
-> Maybe ((ProjConf pt, ProjConfModTimes), proj_info pt)
-> Map DistDirLib unit_info
-> QueryCacheI pre_info progs proj_info unit_info pt
QueryCache Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
forall a. Maybe a
Nothing Maybe (Programs, Programs)
forall a. Maybe a
Nothing Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
forall a. Maybe a
Nothing Map DistDirLib UnitInfo
forall k a. Map k a
Map.empty
QueryEnv pt -> IO (QueryEnv pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryEnv pt -> IO (QueryEnv pt))
-> QueryEnv pt -> IO (QueryEnv pt)
forall a b. (a -> b) -> a -> b
$ $WQueryEnv :: forall (c :: ProjType -> *) (pt :: ProjType).
ReadProcessWithCwdAndEnv
-> CallProcessWithCwdAndEnv ()
-> Programs
-> ProjLoc pt
-> DistDir pt
-> IORef (c pt)
-> IORef (CacheKeyCache pt)
-> QueryEnvI c pt
QueryEnv
{ qeReadProcess :: ReadProcessWithCwdAndEnv
qeReadProcess = \stdin :: String
stdin mcwd :: Maybe String
mcwd env :: [(String, EnvOverride)]
env exe :: String
exe args :: [String]
args -> do
(Verbose => IO String) -> IO String
forall a. (Verbose => IO a) -> IO a
withVerbosity ((Verbose => IO String) -> IO String)
-> (Verbose => IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ Verbose =>
Maybe String
-> [(String, EnvOverride)]
-> String
-> [String]
-> String
-> IO String
Maybe String
-> [(String, EnvOverride)]
-> String
-> [String]
-> String
-> IO String
readProcessStderr Maybe String
mcwd [(String, EnvOverride)]
env String
exe [String]
args ""
, qeCallProcess :: CallProcessWithCwdAndEnv ()
qeCallProcess = \mcwd :: Maybe String
mcwd env :: [(String, EnvOverride)]
env exe :: String
exe args :: [String]
args ->
(Verbose => IO ()) -> IO ()
forall a. (Verbose => IO a) -> IO a
withVerbosity ((Verbose => IO ()) -> IO ()) -> (Verbose => IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbose => CallProcessWithCwdAndEnv ()
CallProcessWithCwdAndEnv ()
callProcessStderr Maybe String
mcwd [(String, EnvOverride)]
env String
exe [String]
args
, qePrograms :: Programs
qePrograms = Programs
defaultPrograms
, qeProjLoc :: ProjLoc pt
qeProjLoc = ProjLoc pt
projloc
, qeDistDir :: DistDir pt
qeDistDir = DistDir pt
distdir
, qeCacheRef :: IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
qeCacheRef = IORef (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
cr
, qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheKeys = String -> IORef (CacheKeyCache pt)
forall a. HasCallStack => String -> a
error "mkQuery: qeCacheKeys is uninitialized!"
}
projConf :: ProjLoc pt -> IO (ProjConf pt)
projConf :: ProjLoc pt -> IO (ProjConf pt)
projConf (ProjLocV1Dir pkgdir :: String
pkgdir) =
String -> ProjConf ('Cabal 'CV1)
ProjConfV1 (String -> ProjConf ('Cabal 'CV1))
-> IO String -> IO (ProjConf ('Cabal 'CV1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe String -> IO String
complainIfNoCabalFile String
pkgdir (Maybe String -> IO String) -> IO (Maybe String) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe String)
findCabalFile String
pkgdir)
projConf (ProjLocV1CabalFile cabal_file :: String
cabal_file _) = ProjConf ('Cabal 'CV1) -> IO (ProjConf pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf ('Cabal 'CV1) -> IO (ProjConf pt))
-> ProjConf ('Cabal 'CV1) -> IO (ProjConf pt)
forall a b. (a -> b) -> a -> b
$
String -> ProjConf ('Cabal 'CV1)
ProjConfV1 String
cabal_file
projConf (ProjLocV2Dir projdir_path :: String
projdir_path) =
ProjLoc ('Cabal 'CV2) -> IO (ProjConf pt)
forall (pt :: ProjType). ProjLoc pt -> IO (ProjConf pt)
projConf (ProjLoc ('Cabal 'CV2) -> IO (ProjConf pt))
-> ProjLoc ('Cabal 'CV2) -> IO (ProjConf pt)
forall a b. (a -> b) -> a -> b
$ String -> String -> ProjLoc ('Cabal 'CV2)
ProjLocV2File (String
projdir_path String -> String -> String
</> "cabal.project") String
projdir_path
projConf (ProjLocV2File proj_file :: String
proj_file _) = ProjConf ('Cabal 'CV2) -> IO (ProjConf pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf ('Cabal 'CV2) -> IO (ProjConf pt))
-> ProjConf ('Cabal 'CV2) -> IO (ProjConf pt)
forall a b. (a -> b) -> a -> b
$
$WProjConfV2 :: String -> String -> String -> ProjConf ('Cabal 'CV2)
ProjConfV2
{ pcV2CabalProjFile :: String
pcV2CabalProjFile = String
proj_file
, pcV2CabalProjLocalFile :: String
pcV2CabalProjLocalFile = String
proj_file String -> String -> String
<.> "local"
, pcV2CabalProjFreezeFile :: String
pcV2CabalProjFreezeFile = String
proj_file String -> String -> String
<.> "freeze"
}
projConf (ProjLocStackYaml stack_yaml :: String
stack_yaml) = ProjConf 'Stack -> IO (ProjConf pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf 'Stack -> IO (ProjConf pt))
-> ProjConf 'Stack -> IO (ProjConf pt)
forall a b. (a -> b) -> a -> b
$
$WProjConfStack :: String -> ProjConf 'Stack
ProjConfStack
{ pcStackYaml :: String
pcStackYaml = String
stack_yaml }
getProjConfModTime :: ProjConf pt -> IO ProjConfModTimes
getProjConfModTime :: ProjConf pt -> IO ProjConfModTimes
getProjConfModTime ProjConfV1{String
pcV1CabalFile :: ProjConf ('Cabal 'CV1) -> String
pcV1CabalFile :: String
pcV1CabalFile} =
([(String, EpochTime)] -> ProjConfModTimes)
-> IO [(String, EpochTime)] -> IO ProjConfModTimes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, EpochTime)] -> ProjConfModTimes
ProjConfModTimes (IO [(String, EpochTime)] -> IO ProjConfModTimes)
-> IO [(String, EpochTime)] -> IO ProjConfModTimes
forall a b. (a -> b) -> a -> b
$ (String -> IO (String, EpochTime))
-> [String] -> IO [(String, EpochTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, EpochTime)
getFileModTime
[ String
pcV1CabalFile
]
getProjConfModTime ProjConfV2{..} = do
([Maybe (String, EpochTime)] -> ProjConfModTimes)
-> IO [Maybe (String, EpochTime)] -> IO ProjConfModTimes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(String, EpochTime)] -> ProjConfModTimes
ProjConfModTimes ([(String, EpochTime)] -> ProjConfModTimes)
-> ([Maybe (String, EpochTime)] -> [(String, EpochTime)])
-> [Maybe (String, EpochTime)]
-> ProjConfModTimes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (String, EpochTime)] -> [(String, EpochTime)]
forall a. [Maybe a] -> [a]
catMaybes) (IO [Maybe (String, EpochTime)] -> IO ProjConfModTimes)
-> IO [Maybe (String, EpochTime)] -> IO ProjConfModTimes
forall a b. (a -> b) -> a -> b
$
(String -> IO (Maybe (String, EpochTime)))
-> [String] -> IO [Maybe (String, EpochTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> IO (String, EpochTime))
-> Maybe String -> IO (Maybe (String, EpochTime))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (String, EpochTime)
getFileModTime (Maybe String -> IO (Maybe (String, EpochTime)))
-> (String -> IO (Maybe String))
-> String
-> IO (Maybe (String, EpochTime))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO (Maybe String)
mightExist)
[ String
pcV2CabalProjFile
, String
pcV2CabalProjLocalFile
, String
pcV2CabalProjFreezeFile
]
getProjConfModTime ProjConfStack{..} =
([(String, EpochTime)] -> ProjConfModTimes)
-> IO [(String, EpochTime)] -> IO ProjConfModTimes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, EpochTime)] -> ProjConfModTimes
ProjConfModTimes (IO [(String, EpochTime)] -> IO ProjConfModTimes)
-> IO [(String, EpochTime)] -> IO ProjConfModTimes
forall a b. (a -> b) -> a -> b
$ (String -> IO (String, EpochTime))
-> [String] -> IO [(String, EpochTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (String, EpochTime)
getFileModTime
[ String
pcStackYaml
]
getUnitModTimes :: Unit pt -> IO UnitModTimes
getUnitModTimes :: Unit pt -> IO UnitModTimes
getUnitModTimes
Unit
{ uDistDir :: forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir=DistDirLib distdirv1 :: String
distdirv1
, uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package
{ pCabalFile :: forall units. Package' units -> CabalFile
pCabalFile=CabalFile cabal_file_path :: String
cabal_file_path
, String
pSourceDir :: String
pSourceDir :: forall units. Package' units -> String
pSourceDir
}
, UnitImpl pt
uImpl :: forall (pt :: ProjType). Unit pt -> UnitImpl pt
uImpl :: UnitImpl pt
uImpl
}
= do
Maybe (String, EpochTime)
umtPkgYaml <-
case UnitImpl pt
uImpl of
UnitImplStack{}
-> (String -> IO (String, EpochTime))
-> Maybe String -> IO (Maybe (String, EpochTime))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (String, EpochTime)
getFileModTime (Maybe String -> IO (Maybe (String, EpochTime)))
-> IO (Maybe String) -> IO (Maybe (String, EpochTime))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe String)
mightExist String
package_yaml_path
_ -> Maybe (String, EpochTime) -> IO (Maybe (String, EpochTime))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, EpochTime)
forall a. Maybe a
Nothing
(String, EpochTime)
umtCabalFile <- String -> IO (String, EpochTime)
getFileModTime String
cabal_file_path
Maybe (String, EpochTime)
umtSetupConfig <- ((String -> IO (String, EpochTime))
-> Maybe String -> IO (Maybe (String, EpochTime))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO (String, EpochTime)
getFileModTime (Maybe String -> IO (Maybe (String, EpochTime)))
-> (String -> IO (Maybe String))
-> String
-> IO (Maybe (String, EpochTime))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO (Maybe String)
mightExist) String
setup_config_path
UnitModTimes -> IO UnitModTimes
forall (m :: * -> *) a. Monad m => a -> m a
return $WUnitModTimes :: Maybe (String, EpochTime)
-> (String, EpochTime) -> Maybe (String, EpochTime) -> UnitModTimes
UnitModTimes {..}
where
package_yaml_path :: String
package_yaml_path = String
pSourceDir String -> String -> String
</> "package.yaml"
setup_config_path :: String
setup_config_path = String
distdirv1 String -> String -> String
</> "setup-config"
someUnit :: ProjInfo pt -> Unit pt
someUnit :: ProjInfo pt -> Unit pt
someUnit proj_info :: ProjInfo pt
proj_info =
NonEmpty (Unit pt) -> Unit pt
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (Unit pt) -> Unit pt) -> NonEmpty (Unit pt) -> Unit pt
forall a b. (a -> b) -> a -> b
$ Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall units. Package' units -> units
pUnits (Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt))
-> Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall a b. (a -> b) -> a -> b
$
NonEmpty (Package' (NonEmpty (Unit pt)))
-> Package' (NonEmpty (Unit pt))
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (Package' (NonEmpty (Unit pt)))
-> Package' (NonEmpty (Unit pt)))
-> NonEmpty (Package' (NonEmpty (Unit pt)))
-> Package' (NonEmpty (Unit pt))
forall a b. (a -> b) -> a -> b
$ ProjInfo pt -> NonEmpty (Package' (NonEmpty (Unit pt)))
forall (pt :: ProjType). ProjInfo pt -> NonEmpty (Package pt)
piPackages ProjInfo pt
proj_info
compilerVersion :: Query pt (String, Version)
compilerVersion :: Query pt (String, Version)
compilerVersion = (QueryEnv pt -> IO (String, Version)) -> Query pt (String, Version)
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO (String, Version))
-> Query pt (String, Version))
-> (QueryEnv pt -> IO (String, Version))
-> Query pt (String, Version)
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe ->
QueryEnv pt -> IO (ProjInfo pt)
forall (pt :: ProjType). QueryEnv pt -> IO (ProjInfo pt)
getProjInfo QueryEnv pt
qe IO (ProjInfo pt)
-> (ProjInfo pt -> IO (String, Version)) -> IO (String, Version)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \proj_info :: ProjInfo pt
proj_info ->
let unit :: Unit pt
unit = ProjInfo pt -> Unit pt
forall (pt :: ProjType). ProjInfo pt -> Unit pt
someUnit ProjInfo pt
proj_info in
case ProjInfo pt -> ProjInfoImpl pt
forall (pt :: ProjType). ProjInfo pt -> ProjInfoImpl pt
piImpl ProjInfo pt
proj_info of
ProjInfoV1 {} -> UnitInfo -> (String, Version)
uiCompilerId (UnitInfo -> (String, Version))
-> IO UnitInfo -> IO (String, Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryEnv pt -> Unit pt -> IO UnitInfo
forall (pt :: ProjType). QueryEnv pt -> Unit pt -> IO UnitInfo
getUnitInfo QueryEnv pt
qe Unit pt
unit
ProjInfoV2 { (String, Version)
piV2CompilerId :: ProjInfoImpl ('Cabal 'CV2) -> (String, Version)
piV2CompilerId :: (String, Version)
piV2CompilerId } -> (String, Version) -> IO (String, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (String, Version)
piV2CompilerId
ProjInfoStack {} -> UnitInfo -> (String, Version)
uiCompilerId (UnitInfo -> (String, Version))
-> IO UnitInfo -> IO (String, Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryEnv pt -> Unit pt -> IO UnitInfo
forall (pt :: ProjType). QueryEnv pt -> Unit pt -> IO UnitInfo
getUnitInfo QueryEnv pt
qe Unit pt
unit
projectPackages :: Query pt (NonEmpty (Package pt))
projectPackages :: Query pt (NonEmpty (Package pt))
projectPackages = (QueryEnv pt -> IO (NonEmpty (Package pt)))
-> Query pt (NonEmpty (Package pt))
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO (NonEmpty (Package pt)))
-> Query pt (NonEmpty (Package pt)))
-> (QueryEnv pt -> IO (NonEmpty (Package pt)))
-> Query pt (NonEmpty (Package pt))
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> ProjInfo pt -> NonEmpty (Package pt)
forall (pt :: ProjType). ProjInfo pt -> NonEmpty (Package pt)
piPackages (ProjInfo pt -> NonEmpty (Package pt))
-> IO (ProjInfo pt) -> IO (NonEmpty (Package pt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryEnv pt -> IO (ProjInfo pt)
forall (pt :: ProjType). QueryEnv pt -> IO (ProjInfo pt)
getProjInfo QueryEnv pt
qe
unitInfo :: Unit pt -> Query pt UnitInfo
unitInfo :: Unit pt -> Query pt UnitInfo
unitInfo u :: Unit pt
u = (QueryEnv pt -> IO UnitInfo) -> Query pt UnitInfo
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO UnitInfo) -> Query pt UnitInfo)
-> (QueryEnv pt -> IO UnitInfo) -> Query pt UnitInfo
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> QueryEnv pt -> Unit pt -> IO UnitInfo
forall (pt :: ProjType). QueryEnv pt -> Unit pt -> IO UnitInfo
getUnitInfo QueryEnv pt
qe Unit pt
u
allUnits :: (UnitInfo -> a) -> Query pt (NonEmpty a)
allUnits :: (UnitInfo -> a) -> Query pt (NonEmpty a)
allUnits f :: UnitInfo -> a
f = do
(UnitInfo -> a) -> NonEmpty UnitInfo -> NonEmpty a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnitInfo -> a
f (NonEmpty UnitInfo -> NonEmpty a)
-> Query pt (NonEmpty UnitInfo) -> Query pt (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Unit pt -> Query pt UnitInfo)
-> NonEmpty (Unit pt) -> Query pt (NonEmpty UnitInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM Unit pt -> Query pt UnitInfo
forall (pt :: ProjType). Unit pt -> Query pt UnitInfo
unitInfo (NonEmpty (Unit pt) -> Query pt (NonEmpty UnitInfo))
-> Query pt (NonEmpty (Unit pt)) -> Query pt (NonEmpty UnitInfo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NonEmpty (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty (Unit pt)) -> NonEmpty (Unit pt))
-> (NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (NonEmpty (Unit pt)))
-> NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (Unit pt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt))
-> NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (NonEmpty (Unit pt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall units. Package' units -> units
pUnits (NonEmpty (Package' (NonEmpty (Unit pt))) -> NonEmpty (Unit pt))
-> Query pt (NonEmpty (Package' (NonEmpty (Unit pt))))
-> Query pt (NonEmpty (Unit pt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query pt (NonEmpty (Package' (NonEmpty (Unit pt))))
forall (pt :: ProjType). Query pt (NonEmpty (Package pt))
projectPackages)
data Cached c ckc k v = Cached
{ Cached c ckc k v -> c -> Maybe (k, v)
cGet :: !(c -> Maybe (k, v))
, Cached c ckc k v -> c -> (k, v) -> c
cSet :: !(c -> (k, v) -> c)
, Cached c ckc k v -> ckc -> Maybe k
cGetKey :: !(ckc -> Maybe k)
, Cached c ckc k v -> ckc -> k -> ckc
cSetKey :: !(ckc -> k -> ckc)
, Cached c ckc k v -> IO k
cCheckKey :: !(IO k)
, Cached c ckc k v -> k -> k -> Bool
cKeyValid :: !(k -> k -> Bool)
, Cached c ckc k v -> k -> IO v
cRegen :: !(k -> IO v)
}
cached :: QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v
-> IO v
cached :: QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v -> IO v
cached qe :: QueryEnvI (QueryCacheI a b c d) pt
qe Cached{..} = do
QueryCacheI a b c d pt
c <- IORef (QueryCacheI a b c d pt) -> IO (QueryCacheI a b c d pt)
forall a. IORef a -> IO a
readIORef (QueryEnvI (QueryCacheI a b c d) pt
-> IORef (QueryCacheI a b c d pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheRef QueryEnvI (QueryCacheI a b c d) pt
qe)
(c' :: QueryCacheI a b c d pt
c', v :: v
v) <- QueryCacheI a b c d pt
-> Maybe (k, v) -> IO (QueryCacheI a b c d pt, v)
checkUpdate QueryCacheI a b c d pt
c (QueryCacheI a b c d pt -> Maybe (k, v)
cGet QueryCacheI a b c d pt
c)
IORef (QueryCacheI a b c d pt) -> QueryCacheI a b c d pt -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (QueryEnvI (QueryCacheI a b c d) pt
-> IORef (QueryCacheI a b c d pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheRef QueryEnvI (QueryCacheI a b c d) pt
qe) QueryCacheI a b c d pt
c'
v -> IO v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
where
checkUpdate :: QueryCacheI a b c d pt
-> Maybe (k, v) -> IO (QueryCacheI a b c d pt, v)
checkUpdate c :: QueryCacheI a b c d pt
c m :: Maybe (k, v)
m = do
CacheKeyCache pt
ckc <- IORef (CacheKeyCache pt) -> IO (CacheKeyCache pt)
forall a. IORef a -> IO a
readIORef (QueryEnvI (QueryCacheI a b c d) pt -> IORef (CacheKeyCache pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeCacheKeys QueryEnvI (QueryCacheI a b c d) pt
qe)
let regen :: k -> IO (k, v)
regen ck :: k
ck = (k
ck,) (v -> (k, v)) -> IO v -> IO (k, v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> IO v
cRegen k
ck
(k, v)
n <- case Maybe (k, v)
m of
Nothing -> do
k
ck <- IO k
cCheckKey
IORef (CacheKeyCache pt) -> CacheKeyCache pt -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (QueryEnvI (QueryCacheI a b c d) pt -> IORef (CacheKeyCache pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeCacheKeys QueryEnvI (QueryCacheI a b c d) pt
qe) (CacheKeyCache pt -> k -> CacheKeyCache pt
cSetKey CacheKeyCache pt
ckc k
ck)
k -> IO (k, v)
regen k
ck
Just old :: (k, v)
old@(old_ck :: k
old_ck, old_v :: v
old_v) -> do
k
ck <- case CacheKeyCache pt -> Maybe k
cGetKey CacheKeyCache pt
ckc of
Just cck :: k
cck ->
k -> IO k
forall (m :: * -> *) a. Monad m => a -> m a
return k
cck
Nothing -> do
k
ck <- IO k
cCheckKey
IORef (CacheKeyCache pt) -> CacheKeyCache pt -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (QueryEnvI (QueryCacheI a b c d) pt -> IORef (CacheKeyCache pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeCacheKeys QueryEnvI (QueryCacheI a b c d) pt
qe) (CacheKeyCache pt -> k -> CacheKeyCache pt
cSetKey CacheKeyCache pt
ckc k
ck)
k -> IO k
forall (m :: * -> *) a. Monad m => a -> m a
return k
ck
if
| k -> k -> Bool
cKeyValid k
old_ck k
ck -> (k, v) -> IO (k, v)
forall (m :: * -> *) a. Monad m => a -> m a
return (k, v)
old
| Bool
otherwise -> k -> IO (k, v)
regen k
ck
(QueryCacheI a b c d pt, v) -> IO (QueryCacheI a b c d pt, v)
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryCacheI a b c d pt -> (k, v) -> QueryCacheI a b c d pt
cSet QueryCacheI a b c d pt
c (k, v)
n, (k, v) -> v
forall a b. (a, b) -> b
snd (k, v)
n)
getProjConfAndModTime :: QueryEnvI c pt -> IO (ProjConf pt, ProjConfModTimes)
getProjConfAndModTime :: QueryEnvI c pt -> IO (ProjConf pt, ProjConfModTimes)
getProjConfAndModTime qe :: QueryEnvI c pt
qe = do
ProjConf pt
proj_conf <- ProjLoc pt -> IO (ProjConf pt)
forall (pt :: ProjType). ProjLoc pt -> IO (ProjConf pt)
projConf (QueryEnvI c pt -> ProjLoc pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qeProjLoc QueryEnvI c pt
qe)
ProjConfModTimes
mtime <- ProjConf pt -> IO ProjConfModTimes
forall (pt :: ProjType). ProjConf pt -> IO ProjConfModTimes
getProjConfModTime ProjConf pt
proj_conf
(ProjConf pt, ProjConfModTimes)
-> IO (ProjConf pt, ProjConfModTimes)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf pt
proj_conf, ProjConfModTimes
mtime)
getPreInfo :: QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo :: QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo qe :: QueryEnvI (QCPreInfo a b c) pt
qe =
QueryEnvI (QCPreInfo a b c) pt
-> Cached
(QueryCacheI PreInfo a b c pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(PreInfo pt)
-> IO (PreInfo pt)
forall (a :: ProjType -> *) b (c :: ProjType -> *) d
(pt :: ProjType) k v.
QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v -> IO v
cached QueryEnvI (QCPreInfo a b c) pt
qe (Cached
(QueryCacheI PreInfo a b c pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(PreInfo pt)
-> IO (PreInfo pt))
-> Cached
(QueryCacheI PreInfo a b c pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(PreInfo pt)
-> IO (PreInfo pt)
forall a b. (a -> b) -> a -> b
$ $WCached :: forall c ckc k v.
(c -> Maybe (k, v))
-> (c -> (k, v) -> c)
-> (ckc -> Maybe k)
-> (ckc -> k -> ckc)
-> IO k
-> (k -> k -> Bool)
-> (k -> IO v)
-> Cached c ckc k v
Cached
{ cGet :: QueryCacheI PreInfo a b c pt
-> Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
cGet = QueryCacheI PreInfo a b c pt
-> Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Maybe ((ProjConf pt, ProjConfModTimes), pre_info pt)
qcPreInfo
, cSet :: QueryCacheI PreInfo a b c pt
-> ((ProjConf pt, ProjConfModTimes), PreInfo pt)
-> QueryCacheI PreInfo a b c pt
cSet = \a :: QueryCacheI PreInfo a b c pt
a b :: ((ProjConf pt, ProjConfModTimes), PreInfo pt)
b -> QueryCacheI PreInfo a b c pt
a { qcPreInfo :: Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
qcPreInfo = ((ProjConf pt, ProjConfModTimes), PreInfo pt)
-> Maybe ((ProjConf pt, ProjConfModTimes), PreInfo pt)
forall a. a -> Maybe a
Just ((ProjConf pt, ProjConfModTimes), PreInfo pt)
b }
, cGetKey :: CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
cGetKey = CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
forall (pt :: ProjType).
CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
ckcProjConf
, cSetKey :: CacheKeyCache pt
-> (ProjConf pt, ProjConfModTimes) -> CacheKeyCache pt
cSetKey = \a :: CacheKeyCache pt
a b :: (ProjConf pt, ProjConfModTimes)
b -> CacheKeyCache pt
a { ckcProjConf :: Maybe (ProjConf pt, ProjConfModTimes)
ckcProjConf = (ProjConf pt, ProjConfModTimes)
-> Maybe (ProjConf pt, ProjConfModTimes)
forall a. a -> Maybe a
Just (ProjConf pt, ProjConfModTimes)
b }
, cCheckKey :: IO (ProjConf pt, ProjConfModTimes)
cCheckKey = QueryEnvI (QCPreInfo a b c) pt
-> IO (ProjConf pt, ProjConfModTimes)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IO (ProjConf pt, ProjConfModTimes)
getProjConfAndModTime QueryEnvI (QCPreInfo a b c) pt
qe
, cKeyValid :: (ProjConf pt, ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes) -> Bool
cKeyValid = ProjConfModTimes -> ProjConfModTimes -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ProjConfModTimes -> ProjConfModTimes -> Bool)
-> ((ProjConf pt, ProjConfModTimes) -> ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ProjConf pt, ProjConfModTimes) -> ProjConfModTimes
forall a b. (a, b) -> b
snd
, cRegen :: (ProjConf pt, ProjConfModTimes) -> IO (PreInfo pt)
cRegen = \_k :: (ProjConf pt, ProjConfModTimes)
_k -> QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IO (PreInfo pt)
readPreInfo QueryEnvI (QCPreInfo a b c) pt
qe
}
readPreInfo :: QueryEnvI c pt -> IO (PreInfo pt)
readPreInfo :: QueryEnvI c pt -> IO (PreInfo pt)
readPreInfo qe :: QueryEnvI c pt
qe = do
case QueryEnvI c pt -> SProjType pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> SProjType pt
projTypeOfQueryEnv QueryEnvI c pt
qe of
SStack -> do
StackProjPaths
piStackProjPaths <- QueryEnvI c 'Stack -> IO StackProjPaths
forall (c :: ProjType -> *).
QueryEnvI c 'Stack -> IO StackProjPaths
Stack.projPaths QueryEnvI c pt
QueryEnvI c 'Stack
qe
PreInfo 'Stack -> IO (PreInfo 'Stack)
forall (m :: * -> *) a. Monad m => a -> m a
return $WPreInfoStack :: StackProjPaths -> PreInfo 'Stack
PreInfoStack
{ StackProjPaths
piStackProjPaths :: StackProjPaths
piStackProjPaths :: StackProjPaths
piStackProjPaths
}
(SCabal _) ->
PreInfo ('Cabal pt) -> IO (PreInfo ('Cabal pt))
forall (m :: * -> *) a. Monad m => a -> m a
return PreInfo ('Cabal pt)
forall (cpt :: CabalProjType). PreInfo ('Cabal cpt)
PreInfoCabal
getProjInfo :: QueryEnv pt -> IO (ProjInfo pt)
getProjInfo :: QueryEnv pt -> IO (ProjInfo pt)
getProjInfo qe :: QueryEnv pt
qe = do
PreInfo pt
pre_info <- QueryEnv pt -> IO (PreInfo pt)
forall a (b :: ProjType -> *) c (pt :: ProjType).
QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo QueryEnv pt
qe
QueryEnv pt
-> Cached
(QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(ProjInfo pt)
-> IO (ProjInfo pt)
forall (a :: ProjType -> *) b (c :: ProjType -> *) d
(pt :: ProjType) k v.
QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v -> IO v
cached QueryEnv pt
qe (Cached
(QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(ProjInfo pt)
-> IO (ProjInfo pt))
-> Cached
(QueryCacheI PreInfo Programs ProjInfo UnitInfo pt)
(CacheKeyCache pt)
(ProjConf pt, ProjConfModTimes)
(ProjInfo pt)
-> IO (ProjInfo pt)
forall a b. (a -> b) -> a -> b
$ $WCached :: forall c ckc k v.
(c -> Maybe (k, v))
-> (c -> (k, v) -> c)
-> (ckc -> Maybe k)
-> (ckc -> k -> ckc)
-> IO k
-> (k -> k -> Bool)
-> (k -> IO v)
-> Cached c ckc k v
Cached
{ cGet :: QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
cGet = QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Maybe ((ProjConf pt, ProjConfModTimes), proj_info pt)
qcProjInfo
, cSet :: QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
-> QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
cSet = \c :: QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
c n :: ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
n@(_, proj_info :: ProjInfo pt
proj_info) ->
let active_units :: [Unit pt]
active_units = NonEmpty (Unit pt) -> [Unit pt]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty (Unit pt) -> [Unit pt])
-> NonEmpty (Unit pt) -> [Unit pt]
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty (Unit pt)) -> NonEmpty (Unit pt))
-> NonEmpty (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall a b. (a -> b) -> a -> b
$
(Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt))
-> NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (NonEmpty (Unit pt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Package' (NonEmpty (Unit pt)) -> NonEmpty (Unit pt)
forall units. Package' units -> units
pUnits (NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (NonEmpty (Unit pt)))
-> NonEmpty (Package' (NonEmpty (Unit pt)))
-> NonEmpty (NonEmpty (Unit pt))
forall a b. (a -> b) -> a -> b
$ ProjInfo pt -> NonEmpty (Package' (NonEmpty (Unit pt)))
forall (pt :: ProjType). ProjInfo pt -> NonEmpty (Package pt)
piPackages ProjInfo pt
proj_info in
QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
c { qcProjInfo :: Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
qcProjInfo = ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
-> Maybe ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
forall a. a -> Maybe a
Just ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
n
, qcUnitInfos :: Map DistDirLib UnitInfo
qcUnitInfos =
[Unit pt] -> Map DistDirLib UnitInfo -> Map DistDirLib UnitInfo
forall (pt :: ProjType).
[Unit pt] -> Map DistDirLib UnitInfo -> Map DistDirLib UnitInfo
discardInactiveUnitInfos [Unit pt]
active_units (QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
-> Map DistDirLib UnitInfo
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Map DistDirLib unit_info
qcUnitInfos QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
c)
}
, cGetKey :: CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
cGetKey = CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
forall (pt :: ProjType).
CacheKeyCache pt -> Maybe (ProjConf pt, ProjConfModTimes)
ckcProjConf
, cSetKey :: CacheKeyCache pt
-> (ProjConf pt, ProjConfModTimes) -> CacheKeyCache pt
cSetKey = \a :: CacheKeyCache pt
a b :: (ProjConf pt, ProjConfModTimes)
b -> CacheKeyCache pt
a { ckcProjConf :: Maybe (ProjConf pt, ProjConfModTimes)
ckcProjConf = (ProjConf pt, ProjConfModTimes)
-> Maybe (ProjConf pt, ProjConfModTimes)
forall a. a -> Maybe a
Just (ProjConf pt, ProjConfModTimes)
b }
, cCheckKey :: IO (ProjConf pt, ProjConfModTimes)
cCheckKey = QueryEnv pt -> IO (ProjConf pt, ProjConfModTimes)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IO (ProjConf pt, ProjConfModTimes)
getProjConfAndModTime QueryEnv pt
qe
, cKeyValid :: (ProjConf pt, ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes) -> Bool
cKeyValid = ProjConfModTimes -> ProjConfModTimes -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ProjConfModTimes -> ProjConfModTimes -> Bool)
-> ((ProjConf pt, ProjConfModTimes) -> ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes)
-> (ProjConf pt, ProjConfModTimes)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ProjConf pt, ProjConfModTimes) -> ProjConfModTimes
forall a b. (a, b) -> b
snd
, cRegen :: (ProjConf pt, ProjConfModTimes) -> IO (ProjInfo pt)
cRegen = \(proj_conf :: ProjConf pt
proj_conf, mtime :: ProjConfModTimes
mtime) -> do
QueryEnv pt -> IO ()
forall (a :: ProjType -> *) b (pt :: ProjType).
QueryEnvI (QCProgs a b) pt -> IO ()
shallowReconfigureProject QueryEnv pt
qe
QueryEnv pt
-> ProjConf pt
-> ProjConfModTimes
-> PreInfo pt
-> IO (ProjInfo pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> ProjConf pt
-> ProjConfModTimes
-> PreInfo pt
-> IO (ProjInfo pt)
readProjInfo QueryEnv pt
qe ProjConf pt
proj_conf ProjConfModTimes
mtime PreInfo pt
pre_info
}
getCabalLibVersion :: QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
getCabalLibVersion :: QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
getCabalLibVersion _ _ ProjInfo{piImpl :: forall (pt :: ProjType). ProjInfo pt -> ProjInfoImpl pt
piImpl=ProjInfoV1 {CabalVersion
piV1CabalVersion :: ProjInfoImpl ('Cabal 'CV1) -> CabalVersion
piV1CabalVersion :: CabalVersion
piV1CabalVersion}} =
CabalVersion -> IO CabalVersion
forall (m :: * -> *) a. Monad m => a -> m a
return CabalVersion
piV1CabalVersion
getCabalLibVersion qe :: QueryEnv pt
qe reconf :: Reconfigured pt
reconf proj_info :: ProjInfo pt
proj_info = do
Unit pt
unit <- case Reconfigured pt
reconf of
AlreadyReconfigured unit :: Unit pt
unit ->
Unit pt -> IO (Unit pt)
forall (m :: * -> *) a. Monad m => a -> m a
return Unit pt
unit
Haven'tReconfigured -> do
let unit :: Unit pt
unit = ProjInfo pt -> Unit pt
forall (pt :: ProjType). ProjInfo pt -> Unit pt
someUnit ProjInfo pt
proj_info
QueryEnv pt -> Unit pt -> IO (Reconfigured pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt)
reconfigureUnit QueryEnv pt
qe Unit pt
unit
Unit pt -> IO (Unit pt)
forall (m :: * -> *) a. Monad m => a -> m a
return Unit pt
unit
let DistDirLib distdir :: String
distdir = Unit pt -> DistDirLib
forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir (Unit pt -> DistDirLib) -> Unit pt -> DistDirLib
forall a b. (a -> b) -> a -> b
$ Unit pt
unit
UnitHeader
hdr <- String -> IO UnitHeader
readSetupConfigHeader (String -> IO UnitHeader) -> String -> IO UnitHeader
forall a b. (a -> b) -> a -> b
$ String
distdir String -> String -> String
</> "setup-config"
let ("Cabal", cabalVer :: Version
cabalVer) = UnitHeader -> (ByteString, Version)
uhSetupId UnitHeader
hdr
CabalVersion -> IO CabalVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalVersion -> IO CabalVersion)
-> CabalVersion -> IO CabalVersion
forall a b. (a -> b) -> a -> b
$ Version -> CabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
cabalVer
getUnitInfo :: QueryEnv pt -> Unit pt -> IO UnitInfo
getUnitInfo :: QueryEnv pt -> Unit pt -> IO UnitInfo
getUnitInfo qe :: QueryEnv pt
qe@QueryEnv{..} unit :: Unit pt
unit@Unit{DistDirLib
uDistDir :: DistDirLib
uDistDir :: forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir} = do
PreInfo pt
pre_info <- QueryEnv pt -> IO (PreInfo pt)
forall a (b :: ProjType -> *) c (pt :: ProjType).
QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo QueryEnv pt
qe
ProjInfo pt
proj_info <- QueryEnv pt -> IO (ProjInfo pt)
forall (pt :: ProjType). QueryEnv pt -> IO (ProjInfo pt)
getProjInfo QueryEnv pt
qe
QueryEnv pt
-> Cached (QueryCache pt) (CacheKeyCache pt) UnitModTimes UnitInfo
-> IO UnitInfo
forall (a :: ProjType -> *) b (c :: ProjType -> *) d
(pt :: ProjType) k v.
QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v -> IO v
cached QueryEnv pt
qe (Cached (QueryCache pt) (CacheKeyCache pt) UnitModTimes UnitInfo
-> IO UnitInfo)
-> Cached (QueryCache pt) (CacheKeyCache pt) UnitModTimes UnitInfo
-> IO UnitInfo
forall a b. (a -> b) -> a -> b
$ $WCached :: forall c ckc k v.
(c -> Maybe (k, v))
-> (c -> (k, v) -> c)
-> (ckc -> Maybe k)
-> (ckc -> k -> ckc)
-> IO k
-> (k -> k -> Bool)
-> (k -> IO v)
-> Cached c ckc k v
Cached
{ cGet :: QueryCache pt -> Maybe (UnitModTimes, UnitInfo)
cGet = \c :: QueryCache pt
c -> do
UnitInfo
ui <- DistDirLib -> Map DistDirLib UnitInfo -> Maybe UnitInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DistDirLib
uDistDir (QueryCache pt -> Map DistDirLib UnitInfo
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Map DistDirLib unit_info
qcUnitInfos QueryCache pt
c)
(UnitModTimes, UnitInfo) -> Maybe (UnitModTimes, UnitInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitInfo -> UnitModTimes
uiModTimes UnitInfo
ui, UnitInfo
ui)
, cSet :: QueryCache pt -> (UnitModTimes, UnitInfo) -> QueryCache pt
cSet = \c :: QueryCache pt
c (_mtimes :: UnitModTimes
_mtimes, unit_info :: UnitInfo
unit_info) -> QueryCache pt
c { qcUnitInfos :: Map DistDirLib UnitInfo
qcUnitInfos =
DistDirLib
-> UnitInfo -> Map DistDirLib UnitInfo -> Map DistDirLib UnitInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert DistDirLib
uDistDir UnitInfo
unit_info (QueryCache pt -> Map DistDirLib UnitInfo
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Map DistDirLib unit_info
qcUnitInfos QueryCache pt
c) }
, cGetKey :: CacheKeyCache pt -> Maybe UnitModTimes
cGetKey = Maybe UnitModTimes -> CacheKeyCache pt -> Maybe UnitModTimes
forall a b. a -> b -> a
const Maybe UnitModTimes
forall a. Maybe a
Nothing
, cSetKey :: CacheKeyCache pt -> UnitModTimes -> CacheKeyCache pt
cSetKey = CacheKeyCache pt -> UnitModTimes -> CacheKeyCache pt
forall a b. a -> b -> a
const
, cCheckKey :: IO UnitModTimes
cCheckKey = Unit pt -> IO UnitModTimes
forall (pt :: ProjType). Unit pt -> IO UnitModTimes
getUnitModTimes Unit pt
unit
, cKeyValid :: UnitModTimes -> UnitModTimes -> Bool
cKeyValid = UnitModTimes -> UnitModTimes -> Bool
forall a. Eq a => a -> a -> Bool
(==)
, cRegen :: UnitModTimes -> IO UnitInfo
cRegen = \mtimes :: UnitModTimes
mtimes -> do
Reconfigured pt
reconf <- QueryEnv pt -> Unit pt -> IO (Reconfigured pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt)
reconfigureUnit QueryEnv pt
qe Unit pt
unit
CabalVersion
cabal_ver <- QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
forall (pt :: ProjType).
QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
getCabalLibVersion QueryEnv pt
qe Reconfigured pt
reconf ProjInfo pt
proj_info
Helper pt
helper <- QueryEnv pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
getHelper QueryEnv pt
qe PreInfo pt
pre_info ProjInfo pt
proj_info CabalVersion
cabal_ver
Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
forall (pt :: ProjType).
Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
readUnitInfo Helper pt
helper Unit pt
unit UnitModTimes
mtimes
}
discardInactiveUnitInfos
:: [Unit pt]
-> Map DistDirLib UnitInfo
-> Map DistDirLib UnitInfo
discardInactiveUnitInfos :: [Unit pt] -> Map DistDirLib UnitInfo -> Map DistDirLib UnitInfo
discardInactiveUnitInfos active_units :: [Unit pt]
active_units uis0 :: Map DistDirLib UnitInfo
uis0 =
Map DistDirLib UnitInfo
-> Set DistDirLib -> Map DistDirLib UnitInfo
forall k a. Ord k => Map k a -> Set k -> Map k a
restrictKeysMap Map DistDirLib UnitInfo
uis0 (Set DistDirLib -> Map DistDirLib UnitInfo)
-> Set DistDirLib -> Map DistDirLib UnitInfo
forall a b. (a -> b) -> a -> b
$ [DistDirLib] -> Set DistDirLib
forall a. Ord a => [a] -> Set a
Set.fromList ([DistDirLib] -> Set DistDirLib) -> [DistDirLib] -> Set DistDirLib
forall a b. (a -> b) -> a -> b
$ (Unit pt -> DistDirLib) -> [Unit pt] -> [DistDirLib]
forall a b. (a -> b) -> [a] -> [b]
map Unit pt -> DistDirLib
forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir [Unit pt]
active_units
where
restrictKeysMap :: Ord k => Map k a -> Set k -> Map k a
restrictKeysMap :: Map k a -> Set k -> Map k a
restrictKeysMap m :: Map k a
m s :: Set k
s = (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k :: k
k _ -> k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member k
k Set k
s) Map k a
m
shallowReconfigureProject :: QueryEnvI (QCProgs a b) pt -> IO ()
shallowReconfigureProject :: QueryEnvI (QCProgs a b) pt -> IO ()
shallowReconfigureProject QueryEnv
{ qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qeProjLoc = ProjLocStackYaml _stack_yaml :: String
_stack_yaml, .. } = do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shallowReconfigureProject qe :: QueryEnvI (QCProgs a b) pt
qe = do
QueryEnvI (QCProgs a b) pt
-> Maybe (Unit pt) -> BuildStage -> IO ()
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget QueryEnvI (QCProgs a b) pt
qe Maybe (Unit pt)
forall a. Maybe a
Nothing BuildStage
DryRun
data Reconfigured pt = AlreadyReconfigured (Unit pt) | Haven'tReconfigured
reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt)
reconfigureUnit :: QueryEnvI c pt -> Unit pt -> IO (Reconfigured pt)
reconfigureUnit qe :: QueryEnvI c pt
qe u :: Unit pt
u = do
QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget QueryEnvI c pt
qe (Unit pt -> Maybe (Unit pt)
forall a. a -> Maybe a
Just Unit pt
u) BuildStage
OnlyCfg
Reconfigured pt -> IO (Reconfigured pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Unit pt -> Reconfigured pt
forall (pt :: ProjType). Unit pt -> Reconfigured pt
AlreadyReconfigured Unit pt
u)
buildUnits :: [Unit pt] -> Query pt ()
buildUnits :: [Unit pt] -> Query pt ()
buildUnits units :: [Unit pt]
units = (QueryEnv pt -> IO ()) -> Query pt ()
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO ()) -> Query pt ())
-> (QueryEnv pt -> IO ()) -> Query pt ()
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> do
Programs
conf_progs <- QueryEnv pt -> IO Programs
forall (a :: ProjType -> *) b (pt :: ProjType).
QueryEnvI (QCProgs a b) pt -> IO Programs
getConfProgs QueryEnv pt
qe
[Unit pt] -> (Unit pt -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Unit pt]
units ((Unit pt -> IO ()) -> IO ()) -> (Unit pt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \u :: Unit pt
u ->
QueryEnv pt -> Maybe (Unit pt) -> BuildStage -> IO ()
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget QueryEnv pt
qe { qePrograms :: Programs
qePrograms = Programs
conf_progs } (Unit pt -> Maybe (Unit pt)
forall a. a -> Maybe a
Just Unit pt
u) BuildStage
DoBuild
buildProject :: Query pt ()
buildProject :: Query pt ()
buildProject = (QueryEnv pt -> IO ()) -> Query pt ()
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO ()) -> Query pt ())
-> (QueryEnv pt -> IO ()) -> Query pt ()
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> do
Programs
conf_progs <- QueryEnv pt -> IO Programs
forall (a :: ProjType -> *) b (pt :: ProjType).
QueryEnvI (QCProgs a b) pt -> IO Programs
getConfProgs QueryEnv pt
qe
QueryEnv pt -> Maybe (Unit pt) -> BuildStage -> IO ()
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget QueryEnv pt
qe { qePrograms :: Programs
qePrograms = Programs
conf_progs } Maybe (Unit pt)
forall a. Maybe a
Nothing BuildStage
DoBuild
data BuildStage = DryRun | OnlyCfg | DoBuild
buildProjectTarget
:: QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget :: QueryEnvI c pt -> Maybe (Unit pt) -> BuildStage -> IO ()
buildProjectTarget qe :: QueryEnvI c pt
qe mu :: Maybe (Unit pt)
mu stage :: BuildStage
stage = do
[String]
stage_opts :: [String] <- [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ case BuildStage
stage of
DryRun -> ["--dry-run"]
OnlyCfg -> ["--only-configure"]
DoBuild -> []
case QueryEnvI c pt
qe of
QueryEnv { qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeDistDir = DistDirCabal cpt :: SCabalProjType pt
cpt distdir :: String
distdir, ProjLoc pt
qeProjLoc :: ProjLoc pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qeProjLoc } -> do
let projdir :: String
projdir = ProjLoc ('Cabal pt) -> String
forall (cpt :: CabalProjType). ProjLoc ('Cabal cpt) -> String
plCabalProjectDir ProjLoc pt
ProjLoc ('Cabal pt)
qeProjLoc
CabalInstallCommand
cmd <- CabalInstallCommand -> IO CabalInstallCommand
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalInstallCommand -> IO CabalInstallCommand)
-> CabalInstallCommand -> IO CabalInstallCommand
forall a b. (a -> b) -> a -> b
$ case BuildStage
stage of
DryRun | SCabalProjType pt
SCV1 <- SCabalProjType pt
cpt ->
CabalInstallCommand
CabalInstall.CIConfigure
OnlyCfg ->
CabalInstallCommand
CabalInstall.CIConfigure
_ ->
CabalInstallCommand
CabalInstall.CIBuild
QueryEnvI c ('Cabal pt)
-> Maybe String -> CabalInstallCommand -> [String] -> IO ()
forall (c :: ProjType -> *) (cpt :: CabalProjType).
QueryEnvI c ('Cabal cpt)
-> Maybe String -> CabalInstallCommand -> [String] -> IO ()
CabalInstall.callCabalInstallCmd QueryEnvI c pt
QueryEnvI c ('Cabal pt)
qe (String -> Maybe String
forall a. a -> Maybe a
Just String
projdir) CabalInstallCommand
cmd ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
case SCabalProjType pt
cpt of
SCV1 ->
[ "--builddir="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
distdir ]
SCV2 -> do
[String]
targets <- [String] -> [[String]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ case Maybe (Unit pt)
mu of
Nothing -> ["all"]
Just Unit{UnitImpl pt
uImpl :: UnitImpl pt
uImpl :: forall (pt :: ProjType). Unit pt -> UnitImpl pt
uImpl} -> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ if UnitImpl ('Cabal 'CV2) -> Bool
uiV2OnlyDependencies UnitImpl pt
UnitImpl ('Cabal 'CV2)
uImpl
then ["--only-dependencies"] else []
, ((ChComponentName, String) -> String)
-> [(ChComponentName, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ChComponentName, String) -> String
forall a b. (a, b) -> b
snd ([(ChComponentName, String)] -> [String])
-> [(ChComponentName, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((ChComponentName, String) -> Bool)
-> [(ChComponentName, String)] -> [(ChComponentName, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ChComponentName -> ChComponentName -> Bool
forall a. Eq a => a -> a -> Bool
/= ChComponentName
ChSetupHsName) (ChComponentName -> Bool)
-> ((ChComponentName, String) -> ChComponentName)
-> (ChComponentName, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChComponentName, String) -> ChComponentName
forall a b. (a, b) -> a
fst) ([(ChComponentName, String)] -> [(ChComponentName, String)])
-> [(ChComponentName, String)] -> [(ChComponentName, String)]
forall a b. (a -> b) -> a -> b
$ UnitImpl ('Cabal 'CV2) -> [(ChComponentName, String)]
uiV2Components UnitImpl pt
UnitImpl ('Cabal 'CV2)
uImpl
]
case ProjLoc pt
qeProjLoc of
ProjLocV2File {String
plCabalProjectFile :: ProjLoc ('Cabal 'CV2) -> String
plCabalProjectFile :: String
plCabalProjectFile} ->
[ "--project-file="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plCabalProjectFile
, "--builddir="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
distdir
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
targets
ProjLocV2Dir {} ->
[ "--builddir="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
distdir
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
targets
QueryEnv { qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeDistDir = DistDirStack mworkdir :: Maybe RelativePath
mworkdir
, qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qeProjLoc = qeProjLoc :: ProjLoc pt
qeProjLoc@ProjLocStackYaml {String
plStackYaml :: ProjLoc 'Stack -> String
plStackYaml :: String
plStackYaml}
} -> do
let projdir :: String
projdir = ProjLoc 'Stack -> String
plStackProjectDir ProjLoc pt
ProjLoc 'Stack
qeProjLoc
let workdir_opts :: [String]
workdir_opts = QueryEnvI c 'Stack -> [String]
forall (c :: ProjType -> *). QueryEnvI c 'Stack -> [String]
Stack.workdirArg QueryEnvI c pt
QueryEnvI c 'Stack
qe
case Maybe (Unit pt)
mu of
Just Unit{uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package{String
pSourceDir :: String
pSourceDir :: forall units. Package' units -> String
pSourceDir}} ->
QueryEnvI c 'Stack -> Maybe String -> [String] -> IO ()
forall (c :: ProjType -> *).
QueryEnvI c 'Stack -> Maybe String -> [String] -> IO ()
Stack.callStackCmd QueryEnvI c pt
QueryEnvI c 'Stack
qe (String -> Maybe String
forall a. a -> Maybe a
Just String
pSourceDir) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[String]
workdir_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ "--stack-yaml="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plStackYaml, "build", "."
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts
Nothing ->
QueryEnvI c 'Stack -> Maybe String -> [String] -> IO ()
forall (c :: ProjType -> *).
QueryEnvI c 'Stack -> Maybe String -> [String] -> IO ()
Stack.callStackCmd QueryEnvI c pt
QueryEnvI c 'Stack
qe (String -> Maybe String
forall a. a -> Maybe a
Just String
projdir) ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
[String]
workdir_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ "--stack-yaml="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plStackYaml, "build"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts
getFileModTime :: FilePath -> IO (FilePath, EpochTime)
getFileModTime :: String -> IO (String, EpochTime)
getFileModTime f :: String
f = do
EpochTime
t <- FileStatus -> EpochTime
modificationTime (FileStatus -> EpochTime) -> IO FileStatus -> IO EpochTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
f
(String, EpochTime) -> IO (String, EpochTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
f, EpochTime
t)
readProjInfo
:: QueryEnvI c pt -> ProjConf pt -> ProjConfModTimes -> PreInfo pt -> IO (ProjInfo pt)
readProjInfo :: QueryEnvI c pt
-> ProjConf pt
-> ProjConfModTimes
-> PreInfo pt
-> IO (ProjInfo pt)
readProjInfo qe :: QueryEnvI c pt
qe pc :: ProjConf pt
pc pcm :: ProjConfModTimes
pcm _pi :: PreInfo pt
_pi = (Verbose => IO (ProjInfo pt)) -> IO (ProjInfo pt)
forall a. (Verbose => IO a) -> IO a
withVerbosity ((Verbose => IO (ProjInfo pt)) -> IO (ProjInfo pt))
-> (Verbose => IO (ProjInfo pt)) -> IO (ProjInfo pt)
forall a b. (a -> b) -> a -> b
$ do
let projloc :: ProjLoc pt
projloc = QueryEnvI c pt -> ProjLoc pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qeProjLoc QueryEnvI c pt
qe
case (QueryEnvI c pt -> DistDir pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeDistDir QueryEnvI c pt
qe, ProjConf pt
pc) of
(DistDirCabal SCV1 distdir :: String
distdir, ProjConfV1{String
pcV1CabalFile :: String
pcV1CabalFile :: ProjConf ('Cabal 'CV1) -> String
pcV1CabalFile}) -> do
String
setup_config_path <- String -> IO String
canonicalizePath (String
distdir String -> String -> String
</> "setup-config")
hdr :: UnitHeader
hdr@(UnitHeader (pkg_name_bs :: ByteString
pkg_name_bs, _pkg_ver :: Version
_pkg_ver) ("Cabal", hdrCabalVersion :: Version
hdrCabalVersion) _)
<- String -> IO UnitHeader
readSetupConfigHeader String
setup_config_path
let
v3_0_0_0 :: Version
v3_0_0_0 = [Int] -> Version
makeVersion [3,0,0,0]
pkg_name :: String
pkg_name
| Version
hdrCabalVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= Version
v3_0_0_0 = ByteString -> String
BSU.toString ByteString
pkg_name_bs
| Bool
otherwise = ByteString -> String
BS8.unpack ByteString
pkg_name_bs
pkg :: Package' (NonEmpty (Unit ('Cabal 'CV1)))
pkg = $WPackage :: forall units.
String
-> String
-> CabalFile
-> [(String, Bool)]
-> units
-> Package' units
Package
{ pPackageName :: String
pPackageName = String
pkg_name
, pSourceDir :: String
pSourceDir = ProjLoc ('Cabal 'CV1) -> String
forall (cpt :: CabalProjType). ProjLoc ('Cabal cpt) -> String
plCabalProjectDir ProjLoc pt
ProjLoc ('Cabal 'CV1)
projloc
, pCabalFile :: CabalFile
pCabalFile = String -> CabalFile
CabalFile String
pcV1CabalFile
, pFlags :: [(String, Bool)]
pFlags = []
, pUnits :: NonEmpty (Unit ('Cabal 'CV1))
pUnits = (Unit ('Cabal 'CV1)
-> [Unit ('Cabal 'CV1)] -> NonEmpty (Unit ('Cabal 'CV1))
forall a. a -> [a] -> NonEmpty a
:|[]) $WUnit :: forall (pt :: ProjType).
UnitId -> Package' () -> DistDirLib -> UnitImpl pt -> Unit pt
Unit
{ uUnitId :: UnitId
uUnitId = String -> UnitId
UnitId String
pkg_name
, uPackage :: Package' ()
uPackage = Package' (NonEmpty (Unit ('Cabal 'CV1)))
pkg { pUnits :: ()
pUnits = () }
, uDistDir :: DistDirLib
uDistDir = String -> DistDirLib
DistDirLib String
distdir
, uImpl :: UnitImpl ('Cabal 'CV1)
uImpl = UnitImpl ('Cabal 'CV1)
UnitImplV1
}
}
piImpl :: ProjInfoImpl ('Cabal 'CV1)
piImpl = $WProjInfoV1 :: UnitHeader -> CabalVersion -> ProjInfoImpl ('Cabal 'CV1)
ProjInfoV1
{ piV1SetupHeader :: UnitHeader
piV1SetupHeader = UnitHeader
hdr
, piV1CabalVersion :: CabalVersion
piV1CabalVersion = Version -> CabalVersion
forall a. Version -> CabalVersion' a
CabalVersion Version
hdrCabalVersion
}
ProjInfo ('Cabal 'CV1) -> IO (ProjInfo ('Cabal 'CV1))
forall (m :: * -> *) a. Monad m => a -> m a
return $WProjInfo :: forall (pt :: ProjType).
NonEmpty (Package pt)
-> ProjInfoImpl pt -> ProjConfModTimes -> ProjInfo pt
ProjInfo
{ piProjConfModTimes :: ProjConfModTimes
piProjConfModTimes = ProjConfModTimes
pcm
, piPackages :: NonEmpty (Package' (NonEmpty (Unit ('Cabal 'CV1))))
piPackages = Package' (NonEmpty (Unit ('Cabal 'CV1)))
pkg Package' (NonEmpty (Unit ('Cabal 'CV1)))
-> [Package' (NonEmpty (Unit ('Cabal 'CV1)))]
-> NonEmpty (Package' (NonEmpty (Unit ('Cabal 'CV1))))
forall a. a -> [a] -> NonEmpty a
:| []
, ProjInfoImpl ('Cabal 'CV1)
piImpl :: ProjInfoImpl ('Cabal 'CV1)
piImpl :: ProjInfoImpl ('Cabal 'CV1)
piImpl
}
(DistDirCabal SCV2 distdirv2 :: String
distdirv2, _) -> do
let plan_path :: String
plan_path = String
distdirv2 String -> String -> String
</> "cache" String -> String -> String
</> "plan.json"
EpochTime
plan_mtime <- FileStatus -> EpochTime
modificationTime (FileStatus -> EpochTime) -> IO FileStatus -> IO EpochTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
plan_path
plan :: PlanJson
plan@PlanJson { pjCabalLibVersion :: PlanJson -> Ver
pjCabalLibVersion=Ver pjCabalLibVersion :: [Int]
pjCabalLibVersion
, Ver
pjCabalVersion :: PlanJson -> Ver
pjCabalVersion :: Ver
pjCabalVersion
, pjCompilerId :: PlanJson -> PkgId
pjCompilerId=PkgId (PkgName compName :: Text
compName) (Ver compVer :: [Int]
compVer)
}
<- String -> IO PlanJson
decodePlanJson String
plan_path
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ver
pjCabalVersion Ver -> Ver -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Ver
Ver [2,4,1,0]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. String -> IO a
panicIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "plan.json was produced by too-old a version of\
\cabal-install. The 'dist-dir' keys will be missing. \
\Please upgrade to at least cabal-instal-2.4.1.0"
Just pkgs :: NonEmpty (Package ('Cabal 'CV2))
pkgs <- [Package ('Cabal 'CV2)] -> Maybe (NonEmpty (Package ('Cabal 'CV2)))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([Package ('Cabal 'CV2)]
-> Maybe (NonEmpty (Package ('Cabal 'CV2))))
-> IO [Package ('Cabal 'CV2)]
-> IO (Maybe (NonEmpty (Package ('Cabal 'CV2))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlanJson -> IO [Package ('Cabal 'CV2)]
CabalInstall.planPackages PlanJson
plan
ProjInfo ('Cabal 'CV2) -> IO (ProjInfo ('Cabal 'CV2))
forall (m :: * -> *) a. Monad m => a -> m a
return $WProjInfo :: forall (pt :: ProjType).
NonEmpty (Package pt)
-> ProjInfoImpl pt -> ProjConfModTimes -> ProjInfo pt
ProjInfo
{ piProjConfModTimes :: ProjConfModTimes
piProjConfModTimes = ProjConfModTimes
pcm
, piPackages :: NonEmpty (Package ('Cabal 'CV2))
piPackages = (Package ('Cabal 'CV2) -> String)
-> NonEmpty (Package ('Cabal 'CV2))
-> NonEmpty (Package ('Cabal 'CV2))
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NonEmpty.sortWith Package ('Cabal 'CV2) -> String
forall units. Package' units -> String
pPackageName NonEmpty (Package ('Cabal 'CV2))
pkgs
, piImpl :: ProjInfoImpl ('Cabal 'CV2)
piImpl = $WProjInfoV2 :: PlanJson
-> EpochTime -> (String, Version) -> ProjInfoImpl ('Cabal 'CV2)
ProjInfoV2
{ piV2Plan :: PlanJson
piV2Plan = PlanJson
plan
, piV2PlanModTime :: EpochTime
piV2PlanModTime = EpochTime
plan_mtime
, piV2CompilerId :: (String, Version)
piV2CompilerId = (Text -> String
Text.unpack Text
compName, [Int] -> Version
makeDataVersion [Int]
compVer)
}
}
(DistDirStack{}, _) -> do
Just cabal_files :: NonEmpty CabalFile
cabal_files <- [CabalFile] -> Maybe (NonEmpty CabalFile)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([CabalFile] -> Maybe (NonEmpty CabalFile))
-> IO [CabalFile] -> IO (Maybe (NonEmpty CabalFile))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryEnvI c 'Stack -> IO [CabalFile]
forall (c :: ProjType -> *). QueryEnvI c 'Stack -> IO [CabalFile]
Stack.listPackageCabalFiles QueryEnvI c pt
QueryEnvI c 'Stack
qe
NonEmpty (Package 'Stack)
pkgs <- (CabalFile -> IO (Package 'Stack))
-> NonEmpty CabalFile -> IO (NonEmpty (Package 'Stack))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (QueryEnvI c 'Stack -> CabalFile -> IO (Package 'Stack)
forall (c :: ProjType -> *).
QueryEnvI c 'Stack -> CabalFile -> IO (Package 'Stack)
Stack.getPackage QueryEnvI c pt
QueryEnvI c 'Stack
qe) NonEmpty CabalFile
cabal_files
ProjInfo 'Stack -> IO (ProjInfo 'Stack)
forall (m :: * -> *) a. Monad m => a -> m a
return $WProjInfo :: forall (pt :: ProjType).
NonEmpty (Package pt)
-> ProjInfoImpl pt -> ProjConfModTimes -> ProjInfo pt
ProjInfo
{ piProjConfModTimes :: ProjConfModTimes
piProjConfModTimes = ProjConfModTimes
pcm
, piPackages :: NonEmpty (Package 'Stack)
piPackages = (Package 'Stack -> String)
-> NonEmpty (Package 'Stack) -> NonEmpty (Package 'Stack)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NonEmpty.sortWith Package 'Stack -> String
forall units. Package' units -> String
pPackageName NonEmpty (Package 'Stack)
pkgs
, piImpl :: ProjInfoImpl 'Stack
piImpl = ProjInfoImpl 'Stack
ProjInfoStack
}
readUnitInfo :: Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
readUnitInfo :: Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
readUnitInfo helper :: Helper pt
helper u :: Unit pt
u@Unit{uImpl :: forall (pt :: ProjType). Unit pt -> UnitImpl pt
uImpl=ui :: UnitImpl pt
ui@UnitImplV2{[(ChComponentName, String)]
uiV2Components :: [(ChComponentName, String)]
uiV2Components :: UnitImpl ('Cabal 'CV2) -> [(ChComponentName, String)]
uiV2Components}} umt :: UnitModTimes
umt
| ChComponentName
ChSetupHsName ChComponentName -> [ChComponentName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((ChComponentName, String) -> ChComponentName)
-> [(ChComponentName, String)] -> [ChComponentName]
forall a b. (a -> b) -> [a] -> [b]
map (ChComponentName, String) -> ChComponentName
forall a b. (a, b) -> a
fst [(ChComponentName, String)]
uiV2Components = do
let unit' :: Unit pt
unit' = Unit pt
u {
uImpl :: UnitImpl pt
uImpl = UnitImpl pt
ui
{ uiV2Components :: [(ChComponentName, String)]
uiV2Components = ((ChComponentName, String) -> Bool)
-> [(ChComponentName, String)] -> [(ChComponentName, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ChComponentName -> ChComponentName -> Bool
forall a. Eq a => a -> a -> Bool
/= ChComponentName
ChSetupHsName) (ChComponentName -> Bool)
-> ((ChComponentName, String) -> ChComponentName)
-> (ChComponentName, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChComponentName, String) -> ChComponentName
forall a b. (a, b) -> a
fst) [(ChComponentName, String)]
uiV2Components
}
}
Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
forall (pt :: ProjType).
Helper pt -> Unit pt -> UnitModTimes -> IO UnitInfo
readUnitInfo Helper pt
helper Unit pt
unit' UnitModTimes
umt
readUnitInfo helper :: Helper pt
helper unit :: Unit pt
unit@Unit {uUnitId :: forall (pt :: ProjType). Unit pt -> UnitId
uUnitId=UnitId
uiUnitId} uiModTimes :: UnitModTimes
uiModTimes = do
[Maybe ChResponse]
res <- Helper pt -> Unit pt -> [String] -> IO [Maybe ChResponse]
forall (pt :: ProjType).
Helper pt -> Unit pt -> [String] -> IO [Maybe ChResponse]
runHelper Helper pt
helper Unit pt
unit
[ "package-id"
, "compiler-id"
, "flags"
, "config-flags"
, "non-default-config-flags"
, "component-info"
]
let [ Just (ChResponseVersion uiPackageId :: (String, Version)
uiPackageId),
Just (ChResponseVersion uiCompilerId :: (String, Version)
uiCompilerId),
Just (ChResponseFlags uiPackageFlags :: [(String, Bool)]
uiPackageFlags),
Just (ChResponseFlags uiConfigFlags :: [(String, Bool)]
uiConfigFlags),
Just (ChResponseFlags uiNonDefaultConfigFlags :: [(String, Bool)]
uiNonDefaultConfigFlags),
Just (ChResponseComponentsInfo uiComponents :: Map ChComponentName ChComponentInfo
uiComponents)
] = [Maybe ChResponse]
res
UnitInfo -> IO UnitInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitInfo -> IO UnitInfo) -> UnitInfo -> IO UnitInfo
forall a b. (a -> b) -> a -> b
$ $WUnitInfo :: UnitId
-> (String, Version)
-> Map ChComponentName ChComponentInfo
-> (String, Version)
-> [(String, Bool)]
-> [(String, Bool)]
-> [(String, Bool)]
-> UnitModTimes
-> UnitInfo
UnitInfo {..}
readHelper
:: QueryEnvI c pt
-> FilePath
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
readHelper :: QueryEnvI c pt
-> String
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
readHelper qe :: QueryEnvI c pt
qe exe :: String
exe cabal_file :: CabalFile
cabal_file distdir :: DistDirLib
distdir args :: [String]
args = do
String
out <- QueryEnvI c pt
-> String -> CabalFile -> DistDirLib -> [String] -> IO String
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> String -> CabalFile -> DistDirLib -> [String] -> IO String
invokeHelper QueryEnvI c pt
qe String
exe CabalFile
cabal_file DistDirLib
distdir [String]
args
let res :: [Maybe ChResponse]
res :: [Maybe ChResponse]
res = String -> [Maybe ChResponse]
forall a. Read a => String -> a
read String
out
IO [Maybe ChResponse] -> IO [Maybe ChResponse]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Maybe ChResponse] -> IO [Maybe ChResponse])
-> IO [Maybe ChResponse] -> IO [Maybe ChResponse]
forall a b. (a -> b) -> a -> b
$ [Maybe ChResponse] -> IO [Maybe ChResponse]
forall a. a -> IO a
evaluate [Maybe ChResponse]
res IO [Maybe ChResponse]
-> (ErrorCall -> IO [Maybe ChResponse]) -> IO [Maybe ChResponse]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \ex :: ErrorCall
ex@ErrorCall{} -> do
Maybe String
md <- String -> IO (Maybe String)
lookupEnv' "CABAL_HELPER_DEBUG"
let msg :: String
msg = "readHelper: exception: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ErrorCall -> String
forall a. Show a => a -> String
show ErrorCall
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'"
String -> IO [Maybe ChResponse]
forall a. String -> IO a
panicIO (String -> IO [Maybe ChResponse])
-> String -> IO [Maybe ChResponse]
forall a b. (a -> b) -> a -> b
$ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Maybe String
md of
Nothing -> "\n for more information set the environment variable CABAL_HELPER_DEBUG and try again"
Just _ -> "\n output:\n'"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
out String -> String -> String
forall a. [a] -> [a] -> [a]
++"'"
invokeHelper
:: QueryEnvI c pt
-> FilePath
-> CabalFile
-> DistDirLib
-> [String]
-> IO String
invokeHelper :: QueryEnvI c pt
-> String -> CabalFile -> DistDirLib -> [String] -> IO String
invokeHelper
QueryEnv {..}
exe :: String
exe
(CabalFile cabal_file_path :: String
cabal_file_path)
(DistDirLib distdir :: String
distdir)
args0 :: [String]
args0
= do
let args1 :: [String]
args1 = String
cabal_file_path String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
distdir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args0
String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadProcessWithCwdAndEnv
qeReadProcess "" Maybe String
forall a. Maybe a
Nothing [] String
exe [String]
args1 IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
\(IOException
_ :: E.IOException) ->
String -> IO String
forall a. String -> IO a
panicIO (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
["invokeHelper", ": ", String
exe, " "
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
args1)
, " failed!"
]
prepare :: Query pt ()
prepare :: Query pt ()
prepare = (QueryEnv pt -> IO ()) -> Query pt ()
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO ()) -> Query pt ())
-> (QueryEnv pt -> IO ()) -> Query pt ()
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> do
PreInfo pt
pre_info <- QueryEnv pt -> IO (PreInfo pt)
forall a (b :: ProjType -> *) c (pt :: ProjType).
QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo QueryEnv pt
qe
ProjInfo pt
proj_info <- QueryEnv pt -> IO (ProjInfo pt)
forall (pt :: ProjType). QueryEnv pt -> IO (ProjInfo pt)
getProjInfo QueryEnv pt
qe
CabalVersion
cabal_ver <- QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
forall (pt :: ProjType).
QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
getCabalLibVersion QueryEnv pt
qe Reconfigured pt
forall (pt :: ProjType). Reconfigured pt
Haven'tReconfigured ProjInfo pt
proj_info
IO (Helper pt) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Helper pt) -> IO ()) -> IO (Helper pt) -> IO ()
forall a b. (a -> b) -> a -> b
$ QueryEnv pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
getHelper QueryEnv pt
qe PreInfo pt
pre_info ProjInfo pt
proj_info CabalVersion
cabal_ver
writeAutogenFiles :: Unit pt -> Query pt ()
writeAutogenFiles :: Unit pt -> Query pt ()
writeAutogenFiles unit :: Unit pt
unit = (QueryEnv pt -> IO ()) -> Query pt ()
forall (pt :: ProjType) a. (QueryEnv pt -> IO a) -> Query pt a
Query ((QueryEnv pt -> IO ()) -> Query pt ())
-> (QueryEnv pt -> IO ()) -> Query pt ()
forall a b. (a -> b) -> a -> b
$ \qe :: QueryEnv pt
qe -> do
PreInfo pt
pre_info <- QueryEnv pt -> IO (PreInfo pt)
forall a (b :: ProjType -> *) c (pt :: ProjType).
QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo QueryEnv pt
qe
ProjInfo pt
proj_info <- QueryEnv pt -> IO (ProjInfo pt)
forall (pt :: ProjType). QueryEnv pt -> IO (ProjInfo pt)
getProjInfo QueryEnv pt
qe
CabalVersion
cabal_ver <- QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
forall (pt :: ProjType).
QueryEnv pt -> Reconfigured pt -> ProjInfo pt -> IO CabalVersion
getCabalLibVersion QueryEnv pt
qe Reconfigured pt
forall (pt :: ProjType). Reconfigured pt
Haven'tReconfigured ProjInfo pt
proj_info
Helper pt
helper <- QueryEnv pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
getHelper QueryEnv pt
qe PreInfo pt
pre_info ProjInfo pt
proj_info CabalVersion
cabal_ver
IO [Maybe ChResponse] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Maybe ChResponse] -> IO ()) -> IO [Maybe ChResponse] -> IO ()
forall a b. (a -> b) -> a -> b
$ Helper pt -> Unit pt -> [String] -> IO [Maybe ChResponse]
forall (pt :: ProjType).
Helper pt -> Unit pt -> [String] -> IO [Maybe ChResponse]
runHelper Helper pt
helper Unit pt
unit ["write-autogen-files"]
getSandboxPkgDb
:: String
-> GHC.GhcVersion
-> FilePath
-> IO (Maybe FilePath)
getSandboxPkgDb :: String -> GhcVersion -> String -> IO (Maybe String)
getSandboxPkgDb buildPlat :: String
buildPlat ghcVer :: GhcVersion
ghcVer projdir :: String
projdir =
String -> GhcVersion -> String -> IO (Maybe String)
CabalHelper.Compiletime.Sandbox.getSandboxPkgDb String
buildPlat GhcVersion
ghcVer String
projdir
buildPlatform :: String
buildPlatform :: String
buildPlatform = Platform -> String
forall a. Pretty a => a -> String
display Platform
Distribution.System.buildPlatform
lookupEnv' :: String -> IO (Maybe String)
lookupEnv' :: String -> IO (Maybe String)
lookupEnv' k :: String
k = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k ([(String, String)] -> Maybe String)
-> IO [(String, String)] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
withVerbosity :: (Verbose => IO a) -> IO a
withVerbosity :: (Verbose => IO a) -> IO a
withVerbosity act :: Verbose => IO a
act = do
Maybe String
x <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "CABAL_HELPER_DEBUG" ([(String, String)] -> Maybe String)
-> IO [(String, String)] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment
let ?verbose = \level ->
case x >>= readMaybe of
Just x | x >= level -> True
_ -> False
IO a
Verbose => IO a
act
getConfProgs :: QueryEnvI (QCProgs a b) pt -> IO Programs
getConfProgs :: QueryEnvI (QCProgs a b) pt -> IO Programs
getConfProgs qe :: QueryEnvI (QCProgs a b) pt
qe = do
PreInfo pt
pre_info <- QueryEnvI (QCProgs a b) pt -> IO (PreInfo pt)
forall a (b :: ProjType -> *) c (pt :: ProjType).
QueryEnvI (QCPreInfo a b c) pt -> IO (PreInfo pt)
getPreInfo QueryEnvI (QCProgs a b) pt
qe
QueryEnvI (QCProgs a b) pt
-> Cached
(QueryCacheI PreInfo Programs a b pt)
(CacheKeyCache pt)
Programs
Programs
-> IO Programs
forall (a :: ProjType -> *) b (c :: ProjType -> *) d
(pt :: ProjType) k v.
QueryEnvI (QueryCacheI a b c d) pt
-> Cached (QueryCacheI a b c d pt) (CacheKeyCache pt) k v -> IO v
cached QueryEnvI (QCProgs a b) pt
qe (Cached
(QueryCacheI PreInfo Programs a b pt)
(CacheKeyCache pt)
Programs
Programs
-> IO Programs)
-> Cached
(QueryCacheI PreInfo Programs a b pt)
(CacheKeyCache pt)
Programs
Programs
-> IO Programs
forall a b. (a -> b) -> a -> b
$ $WCached :: forall c ckc k v.
(c -> Maybe (k, v))
-> (c -> (k, v) -> c)
-> (ckc -> Maybe k)
-> (ckc -> k -> ckc)
-> IO k
-> (k -> k -> Bool)
-> (k -> IO v)
-> Cached c ckc k v
Cached
{ cGet :: QueryCacheI PreInfo Programs a b pt -> Maybe (Programs, Programs)
cGet = QueryCacheI PreInfo Programs a b pt -> Maybe (Programs, Programs)
forall (pre_info :: ProjType -> *) progs
(proj_info :: ProjType -> *) unit_info (pt :: ProjType).
QueryCacheI pre_info progs proj_info unit_info pt
-> Maybe (Programs, progs)
qcConfProgs
, cSet :: QueryCacheI PreInfo Programs a b pt
-> (Programs, Programs) -> QueryCacheI PreInfo Programs a b pt
cSet = \a :: QueryCacheI PreInfo Programs a b pt
a b :: (Programs, Programs)
b -> QueryCacheI PreInfo Programs a b pt
a { qcConfProgs :: Maybe (Programs, Programs)
qcConfProgs = (Programs, Programs) -> Maybe (Programs, Programs)
forall a. a -> Maybe a
Just (Programs, Programs)
b }
, cGetKey :: CacheKeyCache pt -> Maybe Programs
cGetKey = Maybe Programs -> CacheKeyCache pt -> Maybe Programs
forall a b. a -> b -> a
const Maybe Programs
forall a. Maybe a
Nothing
, cSetKey :: CacheKeyCache pt -> Programs -> CacheKeyCache pt
cSetKey = CacheKeyCache pt -> Programs -> CacheKeyCache pt
forall a b. a -> b -> a
const
, cCheckKey :: IO Programs
cCheckKey = Programs -> IO Programs
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryEnvI (QCProgs a b) pt -> Programs
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qePrograms QueryEnvI (QCProgs a b) pt
qe)
, cKeyValid :: Programs -> Programs -> Bool
cKeyValid = Programs -> Programs -> Bool
forall a. Eq a => a -> a -> Bool
(==)
, cRegen :: Programs -> IO Programs
cRegen = \_k :: Programs
_k -> QueryEnvI (QCProgs a b) pt -> PreInfo pt -> IO Programs
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> PreInfo pt -> IO Programs
configurePrograms QueryEnvI (QCProgs a b) pt
qe PreInfo pt
pre_info
}
configurePrograms :: QueryEnvI c pt -> PreInfo pt -> IO Programs
configurePrograms :: QueryEnvI c pt -> PreInfo pt -> IO Programs
configurePrograms qe :: QueryEnvI c pt
qe@QueryEnv{..} pre_info :: PreInfo pt
pre_info = (Verbose => IO Programs) -> IO Programs
forall a. (Verbose => IO a) -> IO a
withVerbosity ((Verbose => IO Programs) -> IO Programs)
-> (Verbose => IO Programs) -> IO Programs
forall a b. (a -> b) -> a -> b
$ do
SProjType pt -> Programs -> IO Programs
forall (pt :: ProjType). SProjType pt -> Programs -> IO Programs
patchBuildToolProgs (QueryEnvI c pt -> SProjType pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> SProjType pt
projTypeOfQueryEnv QueryEnvI c pt
qe) (Programs -> IO Programs)
-> (Programs -> IO Programs) -> Programs -> IO Programs
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Verbose => Programs -> IO Programs
Programs -> IO Programs
guessCompProgramPaths (Programs -> IO Programs) -> Programs -> IO Programs
forall a b. (a -> b) -> a -> b
$
case PreInfo pt
pre_info of
PreInfoStack projPaths :: StackProjPaths
projPaths ->
StackProjPaths -> Programs -> Programs
Stack.patchCompPrograms StackProjPaths
projPaths Programs
qePrograms
_ -> Programs
qePrograms
newtype Helper pt
= Helper { Helper pt -> Unit pt -> [String] -> IO [Maybe ChResponse]
runHelper :: Unit pt -> [String] -> IO [Maybe ChResponse] }
getHelper :: QueryEnvI c pt -> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
getHelper :: QueryEnvI c pt
-> PreInfo pt -> ProjInfo pt -> CabalVersion -> IO (Helper pt)
getHelper qe :: QueryEnvI c pt
qe@QueryEnv{..} _pre_info :: PreInfo pt
_pre_info _proj_info :: ProjInfo pt
_proj_info cabal_ver :: CabalVersion
cabal_ver
| CabalVersion
cabal_ver CabalVersion -> CabalVersion -> Bool
forall a. Eq a => a -> a -> Bool
== CabalVersion
bultinCabalVersion = Helper pt -> IO (Helper pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Helper pt -> IO (Helper pt)) -> Helper pt -> IO (Helper pt)
forall a b. (a -> b) -> a -> b
$ (Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
forall (pt :: ProjType).
(Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
Helper ((Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt)
-> (Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
forall a b. (a -> b) -> a -> b
$
\Unit{ uDistDir :: forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir=DistDirLib distdir :: String
distdir
, uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package{pCabalFile :: forall units. Package' units -> CabalFile
pCabalFile=CabalFile cabal_file :: String
cabal_file}
} args :: [String]
args ->
let pt :: String
pt = SProjType pt -> String
forall (pt :: ProjType). SProjType pt -> String
dispHelperProjectType (QueryEnvI c pt -> SProjType pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> SProjType pt
projTypeOfQueryEnv QueryEnvI c pt
qe) in
[String] -> IO [Maybe ChResponse]
helper_main ([String] -> IO [Maybe ChResponse])
-> [String] -> IO [Maybe ChResponse]
forall a b. (a -> b) -> a -> b
$ String
cabal_file String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
distdir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
pt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
getHelper qe :: QueryEnvI c pt
qe@QueryEnv{..} pre_info :: PreInfo pt
pre_info proj_info :: ProjInfo pt
proj_info cabal_ver :: CabalVersion
cabal_ver = do
(Verbose => IO (Helper pt)) -> IO (Helper pt)
forall a. (Verbose => IO a) -> IO a
withVerbosity ((Verbose => IO (Helper pt)) -> IO (Helper pt))
-> (Verbose => IO (Helper pt)) -> IO (Helper pt)
forall a b. (a -> b) -> a -> b
$ do
let ?progs = qePrograms
TimeSpec
t0 <- Clock -> IO TimeSpec
Clock.getTime Clock
Monotonic
Either ExitCode String
eexe <- Env => CompHelperEnv -> IO (Either ExitCode String)
CompHelperEnv -> IO (Either ExitCode String)
compileHelper (CompHelperEnv -> IO (Either ExitCode String))
-> CompHelperEnv -> IO (Either ExitCode String)
forall a b. (a -> b) -> a -> b
$ ProjLoc pt
-> DistDir pt
-> PreInfo pt
-> ProjInfo pt
-> CabalVersion
-> CompHelperEnv
forall (pt :: ProjType).
Verbose =>
ProjLoc pt
-> DistDir pt
-> PreInfo pt
-> ProjInfo pt
-> CabalVersion
-> CompHelperEnv
mkCompHelperEnv ProjLoc pt
qeProjLoc DistDir pt
qeDistDir PreInfo pt
pre_info ProjInfo pt
proj_info CabalVersion
cabal_ver
TimeSpec
t1 <- Clock -> IO TimeSpec
Clock.getTime Clock
Monotonic
let dt :: Float
dt = (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/10Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^9) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Integer
Clock.toNanoSecs (TimeSpec -> Integer) -> TimeSpec -> Integer
forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
Clock.diffTimeSpec TimeSpec
t0 TimeSpec
t1
dt :: Float
String -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => String -> m ()
vLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Float -> String
forall r. PrintfType r => String -> r
printf "compileHelper took %.5fs" Float
dt
case Either ExitCode String
eexe of
Left rv :: ExitCode
rv ->
String -> IO (Helper pt)
forall a. String -> IO a
panicIO (String -> IO (Helper pt)) -> String -> IO (Helper pt)
forall a b. (a -> b) -> a -> b
$ "compileHelper': compiling helper failed! exit code "String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExitCode -> String
forall a. Show a => a -> String
show ExitCode
rv
Right exe :: String
exe ->
let pt :: String
pt = SProjType pt -> String
forall (pt :: ProjType). SProjType pt -> String
dispHelperProjectType (QueryEnvI c pt -> SProjType pt
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> SProjType pt
projTypeOfQueryEnv QueryEnvI c pt
qe) in
Helper pt -> IO (Helper pt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Helper pt -> IO (Helper pt)) -> Helper pt -> IO (Helper pt)
forall a b. (a -> b) -> a -> b
$ (Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
forall (pt :: ProjType).
(Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
Helper ((Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt)
-> (Unit pt -> [String] -> IO [Maybe ChResponse]) -> Helper pt
forall a b. (a -> b) -> a -> b
$ \Unit{DistDirLib
uDistDir :: DistDirLib
uDistDir :: forall (pt :: ProjType). Unit pt -> DistDirLib
uDistDir, uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package{CabalFile
pCabalFile :: CabalFile
pCabalFile :: forall units. Package' units -> CabalFile
pCabalFile}} args :: [String]
args ->
QueryEnvI c pt
-> String
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt
-> String
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
readHelper QueryEnvI c pt
qe String
exe CabalFile
pCabalFile DistDirLib
uDistDir (String
pt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
dispHelperProjectType :: SProjType pt -> String
dispHelperProjectType :: SProjType pt -> String
dispHelperProjectType (SCabal SCV1) = "v1"
dispHelperProjectType (SCabal SCV2) = "v2"
dispHelperProjectType SStack = "v2"
mkCompHelperEnv
:: Verbose
=> ProjLoc pt
-> DistDir pt
-> PreInfo pt
-> ProjInfo pt
-> CabalVersion
-> CompHelperEnv
mkCompHelperEnv :: ProjLoc pt
-> DistDir pt
-> PreInfo pt
-> ProjInfo pt
-> CabalVersion
-> CompHelperEnv
mkCompHelperEnv
projloc :: ProjLoc pt
projloc
(DistDirCabal SCV1 distdir :: String
distdir)
PreInfoCabal
ProjInfo {}
cabal_ver :: CabalVersion
cabal_ver
= $WCompHelperEnv :: forall cv.
cv
-> [PackageDbDir]
-> String
-> Maybe (Map UnitId Unit)
-> Maybe String
-> String
-> CompHelperEnv' cv
CompHelperEnv
{ cheCabalVer :: CabalVersion
cheCabalVer = CabalVersion
cabal_ver
, cheProjDir :: String
cheProjDir = ProjLoc ('Cabal 'CV1) -> String
forall (cpt :: CabalProjType). ProjLoc ('Cabal cpt) -> String
plCabalProjectDir ProjLoc pt
ProjLoc ('Cabal 'CV1)
projloc
, cheProjLocalCacheDir :: String
cheProjLocalCacheDir = String
distdir
, chePkgDb :: [PackageDbDir]
chePkgDb = []
, chePjUnits :: Maybe (Map UnitId Unit)
chePjUnits = Maybe (Map UnitId Unit)
forall a. Maybe a
Nothing
, cheDistV2 :: Maybe String
cheDistV2 = Maybe String
forall a. Maybe a
Nothing
}
mkCompHelperEnv
projloc :: ProjLoc pt
projloc
(DistDirCabal SCV2 distdir :: String
distdir)
PreInfoCabal
ProjInfo{piImpl :: forall (pt :: ProjType). ProjInfo pt -> ProjInfoImpl pt
piImpl=ProjInfoV2{piV2Plan :: ProjInfoImpl ('Cabal 'CV2) -> PlanJson
piV2Plan=PlanJson
plan}}
cabal_ver :: CabalVersion
cabal_ver
= $WCompHelperEnv :: forall cv.
cv
-> [PackageDbDir]
-> String
-> Maybe (Map UnitId Unit)
-> Maybe String
-> String
-> CompHelperEnv' cv
CompHelperEnv {..}
where
cheProjDir :: String
cheProjDir = ProjLoc ('Cabal 'CV2) -> String
forall (cpt :: CabalProjType). ProjLoc ('Cabal cpt) -> String
plCabalProjectDir ProjLoc pt
ProjLoc ('Cabal 'CV2)
projloc
cheCabalVer :: CabalVersion
cheCabalVer = CabalVersion
cabal_ver
cheProjLocalCacheDir :: String
cheProjLocalCacheDir = String
distdir String -> String -> String
</> "cache"
chePkgDb :: [a]
chePkgDb = []
chePjUnits :: Maybe (Map UnitId Unit)
chePjUnits = Map UnitId Unit -> Maybe (Map UnitId Unit)
forall a. a -> Maybe a
Just (Map UnitId Unit -> Maybe (Map UnitId Unit))
-> Map UnitId Unit -> Maybe (Map UnitId Unit)
forall a b. (a -> b) -> a -> b
$ PlanJson -> Map UnitId Unit
pjUnits PlanJson
plan
cheDistV2 :: Maybe String
cheDistV2 = String -> Maybe String
forall a. a -> Maybe a
Just String
distdir
mkCompHelperEnv
(ProjLocStackYaml stack_yaml :: String
stack_yaml)
(DistDirStack mworkdir :: Maybe RelativePath
mworkdir)
PreInfoStack
{ piStackProjPaths :: PreInfo 'Stack -> StackProjPaths
piStackProjPaths=StackProjPaths
{ PackageDbDir
sppGlobalPkgDb :: StackProjPaths -> PackageDbDir
sppGlobalPkgDb :: PackageDbDir
sppGlobalPkgDb, PackageDbDir
sppSnapPkgDb :: StackProjPaths -> PackageDbDir
sppSnapPkgDb :: PackageDbDir
sppSnapPkgDb, PackageDbDir
sppLocalPkgDb :: StackProjPaths -> PackageDbDir
sppLocalPkgDb :: PackageDbDir
sppLocalPkgDb }
}
ProjInfo {}
cabal_ver :: CabalVersion
cabal_ver
= let workdir :: String
workdir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe ".stack-work" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ RelativePath -> String
unRelativePath (RelativePath -> String) -> Maybe RelativePath -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RelativePath
mworkdir in
let projdir :: String
projdir = String -> String
takeDirectory String
stack_yaml in
$WCompHelperEnv :: forall cv.
cv
-> [PackageDbDir]
-> String
-> Maybe (Map UnitId Unit)
-> Maybe String
-> String
-> CompHelperEnv' cv
CompHelperEnv
{ cheCabalVer :: CabalVersion
cheCabalVer = CabalVersion
cabal_ver
, cheProjDir :: String
cheProjDir = String
projdir
, cheProjLocalCacheDir :: String
cheProjLocalCacheDir = String
projdir String -> String -> String
</> String
workdir
, chePkgDb :: [PackageDbDir]
chePkgDb = [PackageDbDir
sppGlobalPkgDb, PackageDbDir
sppSnapPkgDb, PackageDbDir
sppLocalPkgDb]
, chePjUnits :: Maybe (Map UnitId Unit)
chePjUnits = Maybe (Map UnitId Unit)
forall a. Maybe a
Nothing
, cheDistV2 :: Maybe String
cheDistV2 = Maybe String
forall a. Maybe a
Nothing
}