{-# 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 QueryEnv pt -> IO a
ma) >>= :: Query pt a -> (a -> Query pt b) -> Query pt b
>>= 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
$ \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 -> 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 = (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 QueryEnv pt -> IO a
action) 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 pt
projloc 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
$ QueryEnv :: 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 = \String
stdin Maybe String
mcwd [(String, EnvOverride)]
env String
exe [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 String
""
, qeCallProcess :: CallProcessWithCwdAndEnv ()
qeCallProcess = \Maybe String
mcwd [(String, EnvOverride)]
env String
exe [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 String
"mkQuery: qeCacheKeys is uninitialized!"
}
projConf :: ProjLoc pt -> IO (ProjConf pt)
projConf :: ProjLoc pt -> IO (ProjConf pt)
projConf (ProjLocV1Dir 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 String
cabal_file String
_) = ProjConf ('Cabal 'CV1) -> IO (ProjConf ('Cabal 'CV1))
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf ('Cabal 'CV1) -> IO (ProjConf ('Cabal 'CV1)))
-> ProjConf ('Cabal 'CV1) -> IO (ProjConf ('Cabal 'CV1))
forall a b. (a -> b) -> a -> b
$
String -> ProjConf ('Cabal 'CV1)
ProjConfV1 String
cabal_file
projConf (ProjLocV2Dir String
projdir_path) =
ProjLoc ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2))
forall (pt :: ProjType). ProjLoc pt -> IO (ProjConf pt)
projConf (ProjLoc ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2)))
-> ProjLoc ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2))
forall a b. (a -> b) -> a -> b
$ String -> String -> ProjLoc ('Cabal 'CV2)
ProjLocV2File (String
projdir_path String -> String -> String
</> String
"cabal.project") String
projdir_path
projConf (ProjLocV2File String
proj_file String
_) = ProjConf ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2))
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2)))
-> ProjConf ('Cabal 'CV2) -> IO (ProjConf ('Cabal 'CV2))
forall a b. (a -> b) -> a -> b
$
ProjConfV2 :: String -> String -> String -> ProjConf ('Cabal 'CV2)
ProjConfV2
{ pcV2CabalProjFile :: String
pcV2CabalProjFile = String
proj_file
, pcV2CabalProjLocalFile :: String
pcV2CabalProjLocalFile = String
proj_file String -> String -> String
<.> String
"local"
, pcV2CabalProjFreezeFile :: String
pcV2CabalProjFreezeFile = String
proj_file String -> String -> String
<.> String
"freeze"
}
projConf (ProjLocStackYaml String
stack_yaml) = ProjConf 'Stack -> IO (ProjConf 'Stack)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjConf 'Stack -> IO (ProjConf 'Stack))
-> ProjConf 'Stack -> IO (ProjConf 'Stack)
forall a b. (a -> b) -> a -> b
$
ProjConfStack :: 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{String
pcV2CabalProjFreezeFile :: String
pcV2CabalProjLocalFile :: String
pcV2CabalProjFile :: String
pcV2CabalProjFreezeFile :: ProjConf ('Cabal 'CV2) -> String
pcV2CabalProjLocalFile :: ProjConf ('Cabal 'CV2) -> String
pcV2CabalProjFile :: ProjConf ('Cabal 'CV2) -> String
..} = 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
pcStackYaml :: String
pcStackYaml :: ProjConf 'Stack -> String
..} =
([(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 String
distdirv1
, uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package
{ pCabalFile :: forall units. Package' units -> CabalFile
pCabalFile=CabalFile 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
UnitImpl pt
_ -> 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 UnitModTimes :: Maybe (String, EpochTime)
-> (String, EpochTime) -> Maybe (String, EpochTime) -> UnitModTimes
UnitModTimes {Maybe (String, EpochTime)
(String, EpochTime)
umtSetupConfig :: Maybe (String, EpochTime)
umtCabalFile :: (String, EpochTime)
umtPkgYaml :: Maybe (String, EpochTime)
umtSetupConfig :: Maybe (String, EpochTime)
umtCabalFile :: (String, EpochTime)
umtPkgYaml :: Maybe (String, EpochTime)
..}
where
package_yaml_path :: String
package_yaml_path = String
pSourceDir String -> String -> String
</> String
"package.yaml"
setup_config_path :: String
setup_config_path = String
distdirv1 String -> String -> String
</> String
"setup-config"
someUnit :: ProjInfo pt -> Unit pt
someUnit :: ProjInfo pt -> Unit pt
someUnit 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
$ \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
>>= \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
$ \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 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
$ \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 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 QueryEnvI (QueryCacheI a b c d) pt
qe Cached{IO k
k -> IO v
k -> k -> Bool
CacheKeyCache pt -> Maybe k
CacheKeyCache pt -> k -> CacheKeyCache pt
QueryCacheI a b c d pt -> Maybe (k, v)
QueryCacheI a b c d pt -> (k, v) -> QueryCacheI a b c d pt
cRegen :: k -> IO v
cKeyValid :: k -> k -> Bool
cCheckKey :: IO k
cSetKey :: CacheKeyCache pt -> k -> CacheKeyCache pt
cGetKey :: CacheKeyCache pt -> Maybe k
cSet :: QueryCacheI a b c d pt -> (k, v) -> QueryCacheI a b c d pt
cGet :: QueryCacheI a b c d pt -> Maybe (k, v)
cRegen :: forall c ckc k v. Cached c ckc k v -> k -> IO v
cKeyValid :: forall c ckc k v. Cached c ckc k v -> k -> k -> Bool
cCheckKey :: forall c ckc k v. Cached c ckc k v -> IO k
cSetKey :: forall c ckc k v. Cached c ckc k v -> ckc -> k -> ckc
cGetKey :: forall c ckc k v. Cached c ckc k v -> ckc -> Maybe k
cSet :: forall c ckc k v. Cached c ckc k v -> c -> (k, v) -> c
cGet :: forall c ckc k v. Cached c ckc k v -> c -> Maybe (k, v)
..} = 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)
(QueryCacheI a b c d pt
c', 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 QueryCacheI a b c d pt
c 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 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
Maybe (k, v)
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@(k
old_ck, v
old_v) -> do
k
ck <- case CacheKeyCache pt -> Maybe k
cGetKey CacheKeyCache pt
ckc of
Just k
cck ->
k -> IO k
forall (m :: * -> *) a. Monad m => a -> m a
return k
cck
Maybe k
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 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 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
$ Cached :: 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 = \QueryCacheI PreInfo a b c pt
a ((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 = \CacheKeyCache pt
a (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 = \(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 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
SProjType pt
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 PreInfoStack :: StackProjPaths -> PreInfo 'Stack
PreInfoStack
{ StackProjPaths
piStackProjPaths :: StackProjPaths
piStackProjPaths :: StackProjPaths
piStackProjPaths
}
(SCabal SCabalProjType pt
_) ->
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 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
$ Cached :: 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 = \QueryCacheI PreInfo Programs ProjInfo UnitInfo pt
c n :: ((ProjConf pt, ProjConfModTimes), ProjInfo pt)
n@((ProjConf pt, ProjConfModTimes)
_, 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 = \CacheKeyCache pt
a (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 = \(ProjConf pt
proj_conf, 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 QueryEnv pt
_ Reconfigured pt
_ 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 QueryEnv pt
qe Reconfigured pt
reconf ProjInfo pt
proj_info = do
Unit pt
unit <- case Reconfigured pt
reconf of
AlreadyReconfigured Unit pt
unit ->
Unit pt -> IO (Unit pt)
forall (m :: * -> *) a. Monad m => a -> m a
return Unit pt
unit
Reconfigured pt
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 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
</> String
"setup-config"
let (ByteString
"Cabal", 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{IORef (CacheKeyCache pt)
IORef (QueryCache pt)
Programs
DistDir pt
ProjLoc pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (QueryCache pt)
qeDistDir :: DistDir pt
qeProjLoc :: ProjLoc pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
..} 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
$ Cached :: 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 = \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 = \QueryCache pt
c (UnitModTimes
_mtimes, 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 = \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 [Unit pt]
active_units 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 Map k a
m 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 a
_ -> 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 String
_stack_yaml, IORef (CacheKeyCache pt)
IORef (QCProgs a b pt)
Programs
DistDir pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (QCProgs a b pt)
qeDistDir :: DistDir pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
.. } = do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shallowReconfigureProject 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 QueryEnvI c pt
qe 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 [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
$ \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
$ \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
$ \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 QueryEnvI c pt
qe Maybe (Unit pt)
mu 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
BuildStage
DryRun -> [String
"--dry-run"]
BuildStage
OnlyCfg -> [String
"--only-configure"]
BuildStage
DoBuild -> []
case QueryEnvI c pt
qe of
QueryEnv { qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeDistDir = DistDirCabal SCabalProjType pt
cpt 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
BuildStage
DryRun | SCabalProjType pt
SCV1 <- SCabalProjType pt
cpt ->
CabalInstallCommand
CabalInstall.CIConfigure
BuildStage
OnlyCfg ->
CabalInstallCommand
CabalInstall.CIConfigure
BuildStage
_ ->
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
SCabalProjType pt
SCV1 ->
[ String
"--builddir="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
distdir ]
SCabalProjType pt
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
Maybe (Unit pt)
Nothing -> [String
"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 [String
"--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} ->
[ String
"--project-file="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plCabalProjectFile
, String
"--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 {} ->
[ String
"--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 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]
++
[ String
"--stack-yaml="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plStackYaml, String
"build", String
"."
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts
Maybe (Unit pt)
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]
++
[ String
"--stack-yaml="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
plStackYaml, String
"build"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stage_opts
getFileModTime :: FilePath -> IO (FilePath, EpochTime)
getFileModTime :: String -> IO (String, EpochTime)
getFileModTime 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 QueryEnvI c pt
qe ProjConf pt
pc ProjConfModTimes
pcm 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 SCabalProjType pt
SCV1 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
</> String
"setup-config")
hdr :: UnitHeader
hdr@(UnitHeader (ByteString
pkg_name_bs, Version
_pkg_ver) (ByteString
"Cabal", Version
hdrCabalVersion) (ByteString, Version)
_)
<- String -> IO UnitHeader
readSetupConfigHeader String
setup_config_path
let
v3_0_0_0 :: Version
v3_0_0_0 = [Int] -> Version
makeVersion [Int
3,Int
0,Int
0,Int
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 = Package :: 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
:|[]) Unit :: 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 = ProjInfoV1 :: 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 ProjInfo :: 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 SCabalProjType pt
SCV2 String
distdirv2, ProjConf pt
_) -> do
let plan_path :: String
plan_path = String
distdirv2 String -> String -> String
</> String
"cache" String -> 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 [Int]
pjCabalLibVersion
, Ver
pjCabalVersion :: PlanJson -> Ver
pjCabalVersion :: Ver
pjCabalVersion
, pjCompilerId :: PlanJson -> PkgId
pjCompilerId=PkgId (PkgName Text
compName) (Ver [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 [Int
2,Int
4,Int
1,Int
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
$ String
"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 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 ProjInfo :: 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 = ProjInfoV2 :: 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{}, ProjConf pt
_) -> do
Just 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 ProjInfo :: 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 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}} 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 pt
helper unit :: Unit pt
unit@Unit {uUnitId :: forall (pt :: ProjType). Unit pt -> UnitId
uUnitId=UnitId
uiUnitId} 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
[ String
"package-id"
, String
"compiler-id"
, String
"flags"
, String
"config-flags"
, String
"non-default-config-flags"
, String
"component-info"
]
let [ Just (ChResponseVersion (String, Version)
uiPackageId),
Just (ChResponseVersion (String, Version)
uiCompilerId),
Just (ChResponseFlags [(String, Bool)]
uiPackageFlags),
Just (ChResponseFlags [(String, Bool)]
uiConfigFlags),
Just (ChResponseFlags [(String, Bool)]
uiNonDefaultConfigFlags),
Just (ChResponseComponentsInfo 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
$ UnitInfo :: UnitId
-> (String, Version)
-> Map ChComponentName ChComponentInfo
-> (String, Version)
-> [(String, Bool)]
-> [(String, Bool)]
-> [(String, Bool)]
-> UnitModTimes
-> UnitInfo
UnitInfo {[(String, Bool)]
(String, Version)
Map ChComponentName ChComponentInfo
UnitModTimes
UnitId
uiNonDefaultConfigFlags :: [(String, Bool)]
uiConfigFlags :: [(String, Bool)]
uiPackageFlags :: [(String, Bool)]
uiComponents :: Map ChComponentName ChComponentInfo
uiPackageId :: (String, Version)
uiUnitId :: UnitId
uiComponents :: Map ChComponentName ChComponentInfo
uiNonDefaultConfigFlags :: [(String, Bool)]
uiConfigFlags :: [(String, Bool)]
uiPackageFlags :: [(String, Bool)]
uiCompilerId :: (String, Version)
uiPackageId :: (String, Version)
uiModTimes :: UnitModTimes
uiUnitId :: UnitId
uiModTimes :: UnitModTimes
uiCompilerId :: (String, Version)
..}
readHelper
:: QueryEnvI c pt
-> FilePath
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
readHelper :: QueryEnvI c pt
-> String
-> CabalFile
-> DistDirLib
-> [String]
-> IO [Maybe ChResponse]
readHelper QueryEnvI c pt
qe String
exe CabalFile
cabal_file DistDirLib
distdir [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' String
"CABAL_HELPER_DEBUG"
let msg :: String
msg = String
"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
"'"
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
Maybe String
Nothing -> String
"\n for more information set the environment variable CABAL_HELPER_DEBUG and try again"
Just String
_ -> String
"\n output:\n'"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
out String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
invokeHelper
:: QueryEnvI c pt
-> FilePath
-> CabalFile
-> DistDirLib
-> [String]
-> IO String
invokeHelper :: QueryEnvI c pt
-> String -> CabalFile -> DistDirLib -> [String] -> IO String
invokeHelper
QueryEnv {IORef (c pt)
IORef (CacheKeyCache pt)
Programs
DistDir pt
ProjLoc pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (c pt)
qeDistDir :: DistDir pt
qeProjLoc :: ProjLoc pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
..}
String
exe
(CabalFile String
cabal_file_path)
(DistDirLib String
distdir)
[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 String
"" 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
[String
"invokeHelper", String
": ", String
exe, String
" "
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
args1)
, String
" 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
$ \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 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
$ \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 [String
"write-autogen-files"]
getSandboxPkgDb
:: String
-> GHC.GhcVersion
-> FilePath
-> IO (Maybe FilePath)
getSandboxPkgDb :: String -> GhcVersion -> String -> IO (Maybe String)
getSandboxPkgDb String
buildPlat GhcVersion
ghcVer 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' 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 Verbose => IO a
act = do
Maybe String
x <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"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 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
$ Cached :: 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 = \QueryCacheI PreInfo Programs a b pt
a (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 = \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{IORef (c pt)
IORef (CacheKeyCache pt)
Programs
DistDir pt
ProjLoc pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (c pt)
qeDistDir :: DistDir pt
qeProjLoc :: ProjLoc pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
..} 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 StackProjPaths
projPaths ->
StackProjPaths -> Programs -> Programs
Stack.patchCompPrograms StackProjPaths
projPaths Programs
qePrograms
PreInfo pt
_ -> 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{IORef (c pt)
IORef (CacheKeyCache pt)
Programs
DistDir pt
ProjLoc pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (c pt)
qeDistDir :: DistDir pt
qeProjLoc :: ProjLoc pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
..} PreInfo pt
_pre_info ProjInfo pt
_proj_info 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 String
distdir
, uPackage :: forall (pt :: ProjType). Unit pt -> Package' ()
uPackage=Package{pCabalFile :: forall units. Package' units -> CabalFile
pCabalFile=CabalFile String
cabal_file}
} [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{IORef (c pt)
IORef (CacheKeyCache pt)
Programs
DistDir pt
ProjLoc pt
ReadProcessWithCwdAndEnv
CallProcessWithCwdAndEnv ()
qeCacheKeys :: IORef (CacheKeyCache pt)
qeCacheRef :: IORef (c pt)
qeDistDir :: DistDir pt
qeProjLoc :: ProjLoc pt
qePrograms :: Programs
qeCallProcess :: CallProcessWithCwdAndEnv ()
qeReadProcess :: ReadProcessWithCwdAndEnv
qeCacheRef :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (c pt)
qeCacheKeys :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> IORef (CacheKeyCache pt)
qeDistDir :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> DistDir pt
qeProjLoc :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ProjLoc pt
qePrograms :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> Programs
qeCallProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> CallProcessWithCwdAndEnv ()
qeReadProcess :: forall (c :: ProjType -> *) (pt :: ProjType).
QueryEnvI c pt -> ReadProcessWithCwdAndEnv
..} PreInfo pt
pre_info ProjInfo pt
proj_info 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
/Float
10Float -> Integer -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
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 String
"compileHelper took %.5fs" Float
dt
case Either ExitCode String
eexe of
Left 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
$ String
"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 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}} [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 SCabalProjType pt
SCV1) = String
"v1"
dispHelperProjectType (SCabal SCabalProjType pt
SCV2) = String
"v2"
dispHelperProjectType SProjType pt
SStack = String
"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 pt
projloc
(DistDirCabal SCabalProjType pt
SCV1 String
distdir)
PreInfo pt
PreInfoCabal
ProjInfo {}
CabalVersion
cabal_ver
= CompHelperEnv :: 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 pt
projloc
(DistDirCabal SCabalProjType pt
SCV2 String
distdir)
PreInfo pt
PreInfoCabal
ProjInfo{piImpl :: forall (pt :: ProjType). ProjInfo pt -> ProjInfoImpl pt
piImpl=ProjInfoV2{piV2Plan :: ProjInfoImpl ('Cabal 'CV2) -> PlanJson
piV2Plan=PlanJson
plan}}
CabalVersion
cabal_ver
= CompHelperEnv :: forall cv.
cv
-> [PackageDbDir]
-> String
-> Maybe (Map UnitId Unit)
-> Maybe String
-> String
-> CompHelperEnv' cv
CompHelperEnv {String
[PackageDbDir]
Maybe String
Maybe (Map UnitId Unit)
CabalVersion
forall a. [a]
cheDistV2 :: Maybe String
chePjUnits :: Maybe (Map UnitId Unit)
chePkgDb :: forall a. [a]
cheProjLocalCacheDir :: String
cheCabalVer :: CabalVersion
cheProjDir :: String
cheDistV2 :: Maybe String
chePjUnits :: Maybe (Map UnitId Unit)
chePkgDb :: [PackageDbDir]
cheProjLocalCacheDir :: String
cheProjDir :: String
cheCabalVer :: CabalVersion
..}
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
</> 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 String
stack_yaml)
(DistDirStack 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 {}
CabalVersion
cabal_ver
= let workdir :: String
workdir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
".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
CompHelperEnv :: 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
}