{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}
module HIE.Bios.Cradle (
findCradle
, loadCradle
, loadCustomCradle
, loadImplicitCradle
, defaultCradle
, isCabalCradle
, isStackCradle
, isDirectCradle
, isBiosCradle
, isNoneCradle
, isMultiCradle
, isDefaultCradle
, isOtherCradle
, getCradle
, readProcessWithOutputFile
, makeCradleResult
) where
import Control.Exception (handleJust)
import qualified Data.Yaml as Yaml
import Data.Void
import System.Process
import System.Exit
import HIE.Bios.Types hiding (ActionName(..))
import qualified HIE.Bios.Types as Types
import HIE.Bios.Config
import HIE.Bios.Environment (getCacheDir)
import System.Directory hiding (findFile)
import Control.Monad.Trans.Maybe
import System.FilePath
import Control.Monad
import System.Info.Extra
import Control.Monad.IO.Class
import System.Environment
import Control.Applicative ((<|>), optional)
import System.IO.Temp
import System.IO.Error (isPermissionError)
import Data.List
import Data.Ord (Down(..))
import System.PosixCompat.Files
import HIE.Bios.Wrappers
import System.IO
import Control.DeepSeq
import Data.Conduit.Process
import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit as C
import qualified Data.Conduit.Text as C
import qualified Data.Text as T
import Data.Maybe (fromMaybe, maybeToList)
import GHC.Fingerprint (fingerprintString)
findCradle :: FilePath -> IO (Maybe FilePath)
findCradle :: FilePath -> IO (Maybe FilePath)
findCradle wfile :: FilePath
wfile = do
let wdir :: FilePath
wdir = FilePath -> FilePath
takeDirectory FilePath
wfile
MaybeT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (FilePath -> MaybeT IO FilePath
yamlConfig FilePath
wdir)
loadCradle :: FilePath -> IO (Cradle Void)
loadCradle :: FilePath -> IO (Cradle Void)
loadCradle = CradleOpts -> (Void -> Cradle Void) -> FilePath -> IO (Cradle Void)
forall b a.
FromJSON b =>
CradleOpts -> (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCradleWithOpts CradleOpts
Types.defaultCradleOpts Void -> Cradle Void
forall a. Void -> a
absurd
loadCustomCradle :: Yaml.FromJSON b => (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCustomCradle :: (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCustomCradle = CradleOpts -> (b -> Cradle a) -> FilePath -> IO (Cradle a)
forall b a.
FromJSON b =>
CradleOpts -> (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCradleWithOpts CradleOpts
Types.defaultCradleOpts
loadImplicitCradle :: Show a => FilePath -> IO (Cradle a)
loadImplicitCradle :: FilePath -> IO (Cradle a)
loadImplicitCradle wfile :: FilePath
wfile = do
let wdir :: FilePath
wdir = FilePath -> FilePath
takeDirectory FilePath
wfile
Maybe (CradleConfig Void, FilePath)
cfg <- MaybeT IO (CradleConfig Void, FilePath)
-> IO (Maybe (CradleConfig Void, FilePath))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (FilePath -> MaybeT IO (CradleConfig Void, FilePath)
forall a. FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig FilePath
wdir)
Cradle a -> IO (Cradle a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cradle a -> IO (Cradle a)) -> Cradle a -> IO (Cradle a)
forall a b. (a -> b) -> a -> b
$ case Maybe (CradleConfig Void, FilePath)
cfg of
Just bc :: (CradleConfig Void, FilePath)
bc -> (Void -> Cradle a) -> (CradleConfig Void, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle Void -> Cradle a
forall a. Void -> a
absurd (CradleConfig Void, FilePath)
bc
Nothing -> FilePath -> Cradle a
forall a. FilePath -> Cradle a
defaultCradle FilePath
wdir
loadCradleWithOpts :: (Yaml.FromJSON b) => CradleOpts -> (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCradleWithOpts :: CradleOpts -> (b -> Cradle a) -> FilePath -> IO (Cradle a)
loadCradleWithOpts _copts :: CradleOpts
_copts buildCustomCradle :: b -> Cradle a
buildCustomCradle wfile :: FilePath
wfile = do
CradleConfig b
cradleConfig <- FilePath -> IO (CradleConfig b)
forall b. FromJSON b => FilePath -> IO (CradleConfig b)
readCradleConfig FilePath
wfile
Cradle a -> IO (Cradle a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cradle a -> IO (Cradle a)) -> Cradle a -> IO (Cradle a)
forall a b. (a -> b) -> a -> b
$ (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle b -> Cradle a
buildCustomCradle (CradleConfig b
cradleConfig, FilePath -> FilePath
takeDirectory FilePath
wfile)
getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle buildCustomCradle :: b -> Cradle a
buildCustomCradle (cc :: CradleConfig b
cc, wdir :: FilePath
wdir) = [FilePath] -> Cradle a -> Cradle a
forall a. [FilePath] -> Cradle a -> Cradle a
addCradleDeps [FilePath]
cradleDeps (Cradle a -> Cradle a) -> Cradle a -> Cradle a
forall a b. (a -> b) -> a -> b
$ case CradleConfig b -> CradleType b
forall a. CradleConfig a -> CradleType a
cradleType CradleConfig b
cc of
Cabal mc :: Maybe FilePath
mc -> FilePath -> Maybe FilePath -> Cradle a
forall a. FilePath -> Maybe FilePath -> Cradle a
cabalCradle FilePath
wdir Maybe FilePath
mc
CabalMulti ms :: [(FilePath, FilePath)]
ms ->
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle b -> Cradle a
buildCustomCradle ((CradleConfig b, FilePath) -> Cradle a)
-> (CradleConfig b, FilePath) -> Cradle a
forall a b. (a -> b) -> a -> b
$
([FilePath] -> CradleType b -> CradleConfig b
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [FilePath]
cradleDeps
([(FilePath, CradleConfig b)] -> CradleType b
forall a. [(FilePath, CradleConfig a)] -> CradleType a
Multi [(FilePath
p, [FilePath] -> CradleType b -> CradleConfig b
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [] (Maybe FilePath -> CradleType b
forall a. Maybe FilePath -> CradleType a
Cabal (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
c))) | (p :: FilePath
p, c :: FilePath
c) <- [(FilePath, FilePath)]
ms])
, FilePath
wdir)
Stack mc :: Maybe FilePath
mc -> FilePath -> Maybe FilePath -> Cradle a
forall a. FilePath -> Maybe FilePath -> Cradle a
stackCradle FilePath
wdir Maybe FilePath
mc
StackMulti ms :: [(FilePath, FilePath)]
ms ->
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle b -> Cradle a
buildCustomCradle ((CradleConfig b, FilePath) -> Cradle a)
-> (CradleConfig b, FilePath) -> Cradle a
forall a b. (a -> b) -> a -> b
$
([FilePath] -> CradleType b -> CradleConfig b
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [FilePath]
cradleDeps
([(FilePath, CradleConfig b)] -> CradleType b
forall a. [(FilePath, CradleConfig a)] -> CradleType a
Multi [(FilePath
p, [FilePath] -> CradleType b -> CradleConfig b
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [] (Maybe FilePath -> CradleType b
forall a. Maybe FilePath -> CradleType a
Stack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
c))) | (p :: FilePath
p, c :: FilePath
c) <- [(FilePath, FilePath)]
ms])
, FilePath
wdir)
Bios bios :: Callable
bios deps :: Maybe Callable
deps -> FilePath -> Callable -> Maybe Callable -> Cradle a
forall a. FilePath -> Callable -> Maybe Callable -> Cradle a
biosCradle FilePath
wdir Callable
bios Maybe Callable
deps
Direct xs :: [FilePath]
xs -> FilePath -> [FilePath] -> Cradle a
forall a. FilePath -> [FilePath] -> Cradle a
directCradle FilePath
wdir [FilePath]
xs
None -> FilePath -> Cradle a
forall a. FilePath -> Cradle a
noneCradle FilePath
wdir
Multi ms :: [(FilePath, CradleConfig b)]
ms -> (b -> Cradle a)
-> FilePath -> [(FilePath, CradleConfig b)] -> Cradle a
forall b a.
(b -> Cradle a)
-> FilePath -> [(FilePath, CradleConfig b)] -> Cradle a
multiCradle b -> Cradle a
buildCustomCradle FilePath
wdir [(FilePath, CradleConfig b)]
ms
Other a :: b
a _ -> b -> Cradle a
buildCustomCradle b
a
where
cradleDeps :: [FilePath]
cradleDeps = CradleConfig b -> [FilePath]
forall a. CradleConfig a -> [FilePath]
cradleDependencies CradleConfig b
cc
addCradleDeps :: [FilePath] -> Cradle a -> Cradle a
addCradleDeps :: [FilePath] -> Cradle a -> Cradle a
addCradleDeps deps :: [FilePath]
deps c :: Cradle a
c =
Cradle a
c { cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction a -> CradleAction a
forall a. CradleAction a -> CradleAction a
addActionDeps (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
c) }
where
addActionDeps :: CradleAction a -> CradleAction a
addActionDeps :: CradleAction a -> CradleAction a
addActionDeps ca :: CradleAction a
ca =
CradleAction a
ca { runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = \l :: LoggingFunction
l fp :: FilePath
fp ->
CradleAction a
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
forall a.
CradleAction a
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
runCradle CradleAction a
ca LoggingFunction
l FilePath
fp
IO (CradleLoadResult ComponentOptions)
-> (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
CradleSuccess (ComponentOptions os' :: [FilePath]
os' dir :: FilePath
dir ds :: [FilePath]
ds) ->
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ ComponentOptions -> CradleLoadResult ComponentOptions
forall r. r -> CradleLoadResult r
CradleSuccess ([FilePath] -> FilePath -> [FilePath] -> ComponentOptions
ComponentOptions [FilePath]
os' FilePath
dir ([FilePath]
ds [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
`union` [FilePath]
deps))
CradleFail err :: CradleError
err ->
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult ComponentOptions
forall r. CradleError -> CradleLoadResult r
CradleFail
(CradleError
err { cradleErrorDependencies :: [FilePath]
cradleErrorDependencies = CradleError -> [FilePath]
cradleErrorDependencies CradleError
err [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
`union` [FilePath]
deps })
CradleNone -> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CradleLoadResult ComponentOptions
forall r. CradleLoadResult r
CradleNone
}
implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)
implicitConfig fp :: FilePath
fp = do
(crdType :: CradleType a
crdType, wdir :: FilePath
wdir) <- FilePath -> MaybeT IO (CradleType a, FilePath)
forall a. FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' FilePath
fp
(CradleConfig a, FilePath) -> MaybeT IO (CradleConfig a, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> CradleType a -> CradleConfig a
forall a. [FilePath] -> CradleType a -> CradleConfig a
CradleConfig [] CradleType a
crdType, FilePath
wdir)
implicitConfig' :: FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' :: FilePath -> MaybeT IO (CradleType a, FilePath)
implicitConfig' fp :: FilePath
fp = (\wdir :: FilePath
wdir ->
(Callable -> Maybe Callable -> CradleType a
forall a. Callable -> Maybe Callable -> CradleType a
Bios (FilePath -> Callable
Program (FilePath -> Callable) -> FilePath -> Callable
forall a b. (a -> b) -> a -> b
$ FilePath
wdir FilePath -> FilePath -> FilePath
</> ".hie-bios") Maybe Callable
forall a. Maybe a
Nothing, FilePath
wdir)) (FilePath -> (CradleType a, FilePath))
-> MaybeT IO FilePath -> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MaybeT IO FilePath
biosWorkDir FilePath
fp
MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (MaybeT IO FilePath
stackExecutable MaybeT IO FilePath
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe FilePath -> CradleType a
forall a. Maybe FilePath -> CradleType a
Stack Maybe FilePath
forall a. Maybe a
Nothing,) (FilePath -> (CradleType a, FilePath))
-> MaybeT IO FilePath -> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MaybeT IO FilePath
stackWorkDir FilePath
fp)
MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
-> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe FilePath -> CradleType a
forall a. Maybe FilePath -> CradleType a
Cabal Maybe FilePath
forall a. Maybe a
Nothing,) (FilePath -> (CradleType a, FilePath))
-> MaybeT IO FilePath -> MaybeT IO (CradleType a, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> MaybeT IO FilePath
cabalWorkDir FilePath
fp)
yamlConfig :: FilePath -> MaybeT IO FilePath
yamlConfig :: FilePath -> MaybeT IO FilePath
yamlConfig fp :: FilePath
fp = do
FilePath
configDir <- FilePath -> MaybeT IO FilePath
yamlConfigDirectory FilePath
fp
FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
configDir FilePath -> FilePath -> FilePath
</> FilePath
configFileName)
yamlConfigDirectory :: FilePath -> MaybeT IO FilePath
yamlConfigDirectory :: FilePath -> MaybeT IO FilePath
yamlConfigDirectory = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (FilePath
configFileName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==)
readCradleConfig :: Yaml.FromJSON b => FilePath -> IO (CradleConfig b)
readCradleConfig :: FilePath -> IO (CradleConfig b)
readCradleConfig yamlHie :: FilePath
yamlHie = do
Config b
cfg <- IO (Config b) -> IO (Config b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Config b) -> IO (Config b)) -> IO (Config b) -> IO (Config b)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Config b)
forall a. FromJSON a => FilePath -> IO (Config a)
readConfig FilePath
yamlHie
CradleConfig b -> IO (CradleConfig b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config b -> CradleConfig b
forall a. Config a -> CradleConfig a
cradle Config b
cfg)
configFileName :: FilePath
configFileName :: FilePath
configFileName = "hie.yaml"
isCabalCradle :: Cradle a -> Bool
isCabalCradle :: Cradle a -> Bool
isCabalCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Cabal -> Bool
True
_ -> Bool
False
isStackCradle :: Cradle a -> Bool
isStackCradle :: Cradle a -> Bool
isStackCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Stack -> Bool
True
_ -> Bool
False
isDirectCradle :: Cradle a -> Bool
isDirectCradle :: Cradle a -> Bool
isDirectCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Direct -> Bool
True
_ -> Bool
False
isBiosCradle :: Cradle a -> Bool
isBiosCradle :: Cradle a -> Bool
isBiosCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Bios -> Bool
True
_ -> Bool
False
isMultiCradle :: Cradle a -> Bool
isMultiCradle :: Cradle a -> Bool
isMultiCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Multi -> Bool
True
_ -> Bool
False
isNoneCradle :: Cradle a -> Bool
isNoneCradle :: Cradle a -> Bool
isNoneCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.None -> Bool
True
_ -> Bool
False
isDefaultCradle :: Cradle a -> Bool
isDefaultCradle :: Cradle a -> Bool
isDefaultCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Default -> Bool
True
_ -> Bool
False
isOtherCradle :: Cradle a -> Bool
isOtherCradle :: Cradle a -> Bool
isOtherCradle crdl :: Cradle a
crdl = case CradleAction a -> ActionName a
forall a. CradleAction a -> ActionName a
actionName (Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg Cradle a
crdl) of
Types.Other _ -> Bool
True
_ -> Bool
False
defaultCradle :: FilePath -> Cradle a
defaultCradle :: FilePath -> Cradle a
defaultCradle cur_dir :: FilePath
cur_dir =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
cur_dir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.Default
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = \_ _ ->
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentOptions -> CradleLoadResult ComponentOptions
forall r. r -> CradleLoadResult r
CradleSuccess ([FilePath] -> FilePath -> [FilePath] -> ComponentOptions
ComponentOptions [] FilePath
cur_dir []))
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = FilePath -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmdOnPath FilePath
cur_dir
}
}
noneCradle :: FilePath -> Cradle a
noneCradle :: FilePath -> Cradle a
noneCradle cur_dir :: FilePath
cur_dir =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
cur_dir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.None
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = \_ _ -> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return CradleLoadResult ComponentOptions
forall r. CradleLoadResult r
CradleNone
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = \_ -> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return CradleLoadResult FilePath
forall r. CradleLoadResult r
CradleNone
}
}
multiCradle :: (b -> Cradle a) -> FilePath -> [(FilePath, CradleConfig b)] -> Cradle a
multiCradle :: (b -> Cradle a)
-> FilePath -> [(FilePath, CradleConfig b)] -> Cradle a
multiCradle buildCustomCradle :: b -> Cradle a
buildCustomCradle cur_dir :: FilePath
cur_dir cs :: [(FilePath, CradleConfig b)]
cs =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
cur_dir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
multiActionName
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = \l :: LoggingFunction
l fp :: FilePath
fp -> FilePath -> IO FilePath
makeAbsolute FilePath
fp IO FilePath
-> (FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> Cradle a)
-> FilePath
-> [(FilePath, CradleConfig b)]
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
forall b a.
(b -> Cradle a)
-> FilePath
-> [(FilePath, CradleConfig b)]
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
multiAction b -> Cradle a
buildCustomCradle FilePath
cur_dir [(FilePath, CradleConfig b)]
cs LoggingFunction
l
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = \args :: [FilePath]
args ->
case (CradleConfig b -> Bool) -> [CradleConfig b] -> [CradleConfig b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (CradleConfig b -> Bool) -> CradleConfig b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CradleConfig b -> Bool
forall a. CradleConfig a -> Bool
isNoneCradleConfig) ([CradleConfig b] -> [CradleConfig b])
-> [CradleConfig b] -> [CradleConfig b]
forall a b. (a -> b) -> a -> b
$ ((FilePath, CradleConfig b) -> CradleConfig b)
-> [(FilePath, CradleConfig b)] -> [CradleConfig b]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, CradleConfig b) -> CradleConfig b
forall a b. (a, b) -> b
snd [(FilePath, CradleConfig b)]
cs of
[] -> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return CradleLoadResult FilePath
forall r. CradleLoadResult r
CradleNone
(cfg :: CradleConfig b
cfg:_) -> (CradleAction a -> [FilePath] -> IO (CradleLoadResult FilePath))
-> [FilePath] -> CradleAction a -> IO (CradleLoadResult FilePath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CradleAction a -> [FilePath] -> IO (CradleLoadResult FilePath)
forall a.
CradleAction a -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd [FilePath]
args (CradleAction a -> IO (CradleLoadResult FilePath))
-> CradleAction a -> IO (CradleLoadResult FilePath)
forall a b. (a -> b) -> a -> b
$ Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg (Cradle a -> CradleAction a) -> Cradle a -> CradleAction a
forall a b. (a -> b) -> a -> b
$
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle b -> Cradle a
buildCustomCradle (CradleConfig b
cfg, FilePath
cur_dir)
}
}
where
cfgs :: [CradleConfig b]
cfgs = ((FilePath, CradleConfig b) -> CradleConfig b)
-> [(FilePath, CradleConfig b)] -> [CradleConfig b]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, CradleConfig b) -> CradleConfig b
forall a b. (a, b) -> b
snd [(FilePath, CradleConfig b)]
cs
multiActionName :: ActionName a
multiActionName
| (CradleConfig b -> Bool) -> [CradleConfig b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\c :: CradleConfig b
c -> CradleConfig b -> Bool
forall a. CradleConfig a -> Bool
isStackCradleConfig CradleConfig b
c Bool -> Bool -> Bool
|| CradleConfig b -> Bool
forall a. CradleConfig a -> Bool
isNoneCradleConfig CradleConfig b
c) [CradleConfig b]
cfgs
= ActionName a
forall a. ActionName a
Types.Stack
| (CradleConfig b -> Bool) -> [CradleConfig b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\c :: CradleConfig b
c -> CradleConfig b -> Bool
forall a. CradleConfig a -> Bool
isCabalCradleConfig CradleConfig b
c Bool -> Bool -> Bool
|| CradleConfig b -> Bool
forall a. CradleConfig a -> Bool
isNoneCradleConfig CradleConfig b
c) [CradleConfig b]
cfgs
= ActionName a
forall a. ActionName a
Types.Cabal
| Bool
otherwise
= ActionName a
forall a. ActionName a
Types.Multi
isStackCradleConfig :: CradleConfig a -> Bool
isStackCradleConfig cfg :: CradleConfig a
cfg = case CradleConfig a -> CradleType a
forall a. CradleConfig a -> CradleType a
cradleType CradleConfig a
cfg of
Stack{} -> Bool
True
StackMulti{} -> Bool
True
_ -> Bool
False
isCabalCradleConfig :: CradleConfig a -> Bool
isCabalCradleConfig cfg :: CradleConfig a
cfg = case CradleConfig a -> CradleType a
forall a. CradleConfig a -> CradleType a
cradleType CradleConfig a
cfg of
Cabal{} -> Bool
True
CabalMulti{} -> Bool
True
_ -> Bool
False
isNoneCradleConfig :: CradleConfig a -> Bool
isNoneCradleConfig cfg :: CradleConfig a
cfg = case CradleConfig a -> CradleType a
forall a. CradleConfig a -> CradleType a
cradleType CradleConfig a
cfg of
None -> Bool
True
_ -> Bool
False
multiAction :: forall b a
. (b -> Cradle a)
-> FilePath
-> [(FilePath, CradleConfig b)]
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
multiAction :: (b -> Cradle a)
-> FilePath
-> [(FilePath, CradleConfig b)]
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
multiAction buildCustomCradle :: b -> Cradle a
buildCustomCradle cur_dir :: FilePath
cur_dir cs :: [(FilePath, CradleConfig b)]
cs l :: LoggingFunction
l cur_fp :: FilePath
cur_fp =
[(FilePath, CradleConfig b)]
-> IO (CradleLoadResult ComponentOptions)
selectCradle ([(FilePath, CradleConfig b)]
-> IO (CradleLoadResult ComponentOptions))
-> IO [(FilePath, CradleConfig b)]
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [(FilePath, CradleConfig b)]
canonicalizeCradles
where
err_msg :: [FilePath]
err_msg = ["Multi Cradle: No prefixes matched"
, "pwd: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cur_dir
, "filepath: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cur_fp
, "prefixes:"
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [(FilePath, CradleType b) -> FilePath
forall a. Show a => a -> FilePath
show (FilePath
pf, CradleConfig b -> CradleType b
forall a. CradleConfig a -> CradleType a
cradleType CradleConfig b
cc) | (pf :: FilePath
pf, cc :: CradleConfig b
cc) <- [(FilePath, CradleConfig b)]
cs]
canonicalizeCradles :: IO [(FilePath, CradleConfig b)]
canonicalizeCradles :: IO [(FilePath, CradleConfig b)]
canonicalizeCradles =
((FilePath, CradleConfig b) -> Down FilePath)
-> [(FilePath, CradleConfig b)] -> [(FilePath, CradleConfig b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FilePath -> Down FilePath
forall a. a -> Down a
Down (FilePath -> Down FilePath)
-> ((FilePath, CradleConfig b) -> FilePath)
-> (FilePath, CradleConfig b)
-> Down FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, CradleConfig b) -> FilePath
forall a b. (a, b) -> a
fst)
([(FilePath, CradleConfig b)] -> [(FilePath, CradleConfig b)])
-> IO [(FilePath, CradleConfig b)]
-> IO [(FilePath, CradleConfig b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, CradleConfig b) -> IO (FilePath, CradleConfig b))
-> [(FilePath, CradleConfig b)] -> IO [(FilePath, CradleConfig b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(p :: FilePath
p, c :: CradleConfig b
c) -> (,CradleConfig b
c) (FilePath -> (FilePath, CradleConfig b))
-> IO FilePath -> IO (FilePath, CradleConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO FilePath
makeAbsolute (FilePath
cur_dir FilePath -> FilePath -> FilePath
</> FilePath
p))) [(FilePath, CradleConfig b)]
cs
selectCradle :: [(FilePath, CradleConfig b)]
-> IO (CradleLoadResult ComponentOptions)
selectCradle [] =
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleError -> CradleLoadResult ComponentOptions
forall r. CradleError -> CradleLoadResult r
CradleFail ([FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [] ExitCode
ExitSuccess [FilePath]
err_msg))
selectCradle ((p :: FilePath
p, c :: CradleConfig b
c): css :: [(FilePath, CradleConfig b)]
css) =
if FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
cur_fp
then CradleAction a
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
forall a.
CradleAction a
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
runCradle
(Cradle a -> CradleAction a
forall a. Cradle a -> CradleAction a
cradleOptsProg ((b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
forall b a.
(b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a
getCradle b -> Cradle a
buildCustomCradle (CradleConfig b
c, FilePath
cur_dir)))
LoggingFunction
l
FilePath
cur_fp
else [(FilePath, CradleConfig b)]
-> IO (CradleLoadResult ComponentOptions)
selectCradle [(FilePath, CradleConfig b)]
css
directCradle :: FilePath -> [String] -> Cradle a
directCradle :: FilePath -> [FilePath] -> Cradle a
directCradle wdir :: FilePath
wdir args :: [FilePath]
args =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.Direct
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = \_ _ ->
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentOptions -> CradleLoadResult ComponentOptions
forall r. r -> CradleLoadResult r
CradleSuccess ([FilePath] -> FilePath -> [FilePath] -> ComponentOptions
ComponentOptions [FilePath]
args FilePath
wdir []))
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = FilePath -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmdOnPath FilePath
wdir
}
}
biosCradle :: FilePath -> Callable -> Maybe Callable -> Cradle a
biosCradle :: FilePath -> Callable -> Maybe Callable -> Cradle a
biosCradle wdir :: FilePath
wdir biosCall :: Callable
biosCall biosDepsCall :: Maybe Callable
biosDepsCall =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.Bios
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = FilePath
-> Callable
-> Maybe Callable
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
biosAction FilePath
wdir Callable
biosCall Maybe Callable
biosDepsCall
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = FilePath -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmdOnPath FilePath
wdir
}
}
biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir :: FilePath -> MaybeT IO FilePath
biosWorkDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (".hie-bios" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==)
biosDepsAction :: LoggingFunction -> FilePath -> Maybe Callable -> IO [FilePath]
biosDepsAction :: LoggingFunction -> FilePath -> Maybe Callable -> IO [FilePath]
biosDepsAction l :: LoggingFunction
l wdir :: FilePath
wdir (Just biosDepsCall :: Callable
biosDepsCall) = do
CreateProcess
biosDeps' <- Callable -> Maybe FilePath -> IO CreateProcess
callableToProcess Callable
biosDepsCall Maybe FilePath
forall a. Maybe a
Nothing
(ex :: ExitCode
ex, sout :: [FilePath]
sout, serr :: [FilePath]
serr, args :: [FilePath]
args) <- LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile LoggingFunction
l FilePath
wdir CreateProcess
biosDeps'
case ExitCode
ex of
ExitFailure _ -> FilePath -> IO [FilePath]
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (ExitCode, [FilePath], [FilePath]) -> FilePath
forall a. Show a => a -> FilePath
show (ExitCode
ex, [FilePath]
sout, [FilePath]
serr)
ExitSuccess -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
args
biosDepsAction _ _ Nothing = [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
biosAction :: FilePath
-> Callable
-> Maybe Callable
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
biosAction :: FilePath
-> Callable
-> Maybe Callable
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
biosAction wdir :: FilePath
wdir bios :: Callable
bios bios_deps :: Maybe Callable
bios_deps l :: LoggingFunction
l fp :: FilePath
fp = do
CreateProcess
bios' <- Callable -> Maybe FilePath -> IO CreateProcess
callableToProcess Callable
bios (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp)
(ex :: ExitCode
ex, _stdo :: [FilePath]
_stdo, std :: [FilePath]
std, res :: [FilePath]
res) <- LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile LoggingFunction
l FilePath
wdir CreateProcess
bios'
[FilePath]
deps <- LoggingFunction -> FilePath -> Maybe Callable -> IO [FilePath]
biosDepsAction LoggingFunction
l FilePath
wdir Maybe Callable
bios_deps
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ (ExitCode, [FilePath], FilePath, [FilePath])
-> [FilePath] -> CradleLoadResult ComponentOptions
makeCradleResult (ExitCode
ex, [FilePath]
std, FilePath
wdir, [FilePath]
res) [FilePath]
deps
callableToProcess :: Callable -> Maybe String -> IO CreateProcess
callableToProcess :: Callable -> Maybe FilePath -> IO CreateProcess
callableToProcess (Command shellCommand :: FilePath
shellCommand) file :: Maybe FilePath
file = do
[(FilePath, FilePath)]
old_env <- IO [(FilePath, FilePath)]
getEnvironment
CreateProcess -> IO CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> IO CreateProcess)
-> CreateProcess -> IO CreateProcess
forall a b. (a -> b) -> a -> b
$ (FilePath -> CreateProcess
shell FilePath
shellCommand) { env :: Maybe [(FilePath, FilePath)]
env = ((FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
old_env) ((FilePath, FilePath) -> [(FilePath, FilePath)])
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (,) FilePath
hieBiosArg (FilePath -> [(FilePath, FilePath)])
-> Maybe FilePath -> Maybe [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
file }
where
hieBiosArg :: FilePath
hieBiosArg = "HIE_BIOS_ARG"
callableToProcess (Program path :: FilePath
path) file :: Maybe FilePath
file = do
FilePath
canon_path <- FilePath -> IO FilePath
canonicalizePath FilePath
path
CreateProcess -> IO CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> IO CreateProcess)
-> CreateProcess -> IO CreateProcess
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> CreateProcess
proc FilePath
canon_path (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
file)
cabalCradle :: FilePath -> Maybe String -> Cradle a
cabalCradle :: FilePath -> Maybe FilePath -> Cradle a
cabalCradle wdir :: FilePath
wdir mc :: Maybe FilePath
mc =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.Cabal
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = FilePath
-> Maybe FilePath
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
cabalAction FilePath
wdir Maybe FilePath
mc
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = \args :: [FilePath]
args -> do
Bool -> LoggingFunction
createDirectoryIfMissing Bool
True (FilePath
wdir FilePath -> FilePath -> FilePath
</> "dist-newstyle" FilePath -> FilePath -> FilePath
</> "tmp")
FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> IO (CradleLoadResult FilePath)
readProcessWithCwd
FilePath
wdir "cabal" (["v2-exec", "ghc", "-v0", "--"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args) ""
}
}
cabalCradleDependencies :: FilePath -> FilePath -> IO [FilePath]
cabalCradleDependencies :: FilePath -> FilePath -> IO [FilePath]
cabalCradleDependencies rootDir :: FilePath
rootDir componentDir :: FilePath
componentDir = do
let relFp :: FilePath
relFp = FilePath -> FilePath -> FilePath
makeRelative FilePath
rootDir FilePath
componentDir
[FilePath]
cabalFiles' <- FilePath -> IO [FilePath]
findCabalFiles FilePath
componentDir
let cabalFiles :: [FilePath]
cabalFiles = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
relFp FilePath -> FilePath -> FilePath
</>) [FilePath]
cabalFiles'
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
normalise ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
cabalFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["cabal.project", "cabal.project.local"]
findCabalFiles :: FilePath -> IO [FilePath]
findCabalFiles :: FilePath -> IO [FilePath]
findCabalFiles wdir :: FilePath
wdir = do
[FilePath]
dirContent <- FilePath -> IO [FilePath]
listDirectory FilePath
wdir
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".cabal") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
dirContent
processCabalWrapperArgs :: [String] -> Maybe (FilePath, [String])
processCabalWrapperArgs :: [FilePath] -> Maybe (FilePath, [FilePath])
processCabalWrapperArgs args :: [FilePath]
args =
case [FilePath]
args of
(dir :: FilePath
dir: ghc_args :: [FilePath]
ghc_args) ->
let final_args :: [FilePath]
final_args =
[FilePath] -> [FilePath]
removeVerbosityOpts
([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
removeRTS
([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
removeInteractive
([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
ghc_args
in (FilePath, [FilePath]) -> Maybe (FilePath, [FilePath])
forall a. a -> Maybe a
Just (FilePath
dir, [FilePath]
final_args)
_ -> Maybe (FilePath, [FilePath])
forall a. Maybe a
Nothing
type GhcProc = (FilePath, [String])
withCabalWrapperTool :: GhcProc -> FilePath -> (FilePath -> IO a) -> IO a
withCabalWrapperTool :: (FilePath, [FilePath]) -> FilePath -> (FilePath -> IO a) -> IO a
withCabalWrapperTool (ghcPath :: FilePath
ghcPath, ghcArgs :: [FilePath]
ghcArgs) wdir :: FilePath
wdir k :: FilePath -> IO a
k = do
if Bool
isWindows
then do
FilePath
cacheDir <- FilePath -> IO FilePath
getCacheDir ""
let srcHash :: FilePath
srcHash = Fingerprint -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> Fingerprint
fingerprintString FilePath
cabalWrapperHs)
let wrapper_name :: FilePath
wrapper_name = "wrapper-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
srcHash
let wrapper_fp :: FilePath
wrapper_fp = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
wrapper_name FilePath -> FilePath -> FilePath
<.> "exe"
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
wrapper_fp
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> LoggingFunction -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> m a) -> m a
withSystemTempDirectory "hie-bios" (LoggingFunction -> IO ()) -> LoggingFunction -> IO ()
forall a b. (a -> b) -> a -> b
$ \ tmpDir :: FilePath
tmpDir -> do
Bool -> LoggingFunction
createDirectoryIfMissing Bool
True FilePath
cacheDir
let wrapper_hs :: FilePath
wrapper_hs = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
wrapper_name FilePath -> FilePath -> FilePath
<.> "hs"
FilePath -> LoggingFunction
writeFile FilePath
wrapper_hs FilePath
cabalWrapperHs
let ghc :: CreateProcess
ghc = (FilePath -> [FilePath] -> CreateProcess
proc FilePath
ghcPath ([FilePath] -> CreateProcess) -> [FilePath] -> CreateProcess
forall a b. (a -> b) -> a -> b
$
[FilePath]
ghcArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["-rtsopts=ignore", "-outputdir", FilePath
tmpDir, "-o", FilePath
wrapper_fp, FilePath
wrapper_hs])
{ cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
wdir }
CreateProcess -> FilePath -> IO FilePath
readCreateProcess CreateProcess
ghc "" IO FilePath -> LoggingFunction -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingFunction
putStr
LoggingFunction
setMode FilePath
wrapper_fp
FilePath -> IO a
k FilePath
wrapper_fp
else FilePath -> (FilePath -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile "bios-wrapper"
(\loc :: FilePath
loc h :: Handle
h -> do
Handle -> LoggingFunction
hPutStr Handle
h FilePath
cabalWrapper
Handle -> IO ()
hClose Handle
h
LoggingFunction
setMode FilePath
loc
FilePath -> IO a
k FilePath
loc)
where
setMode :: LoggingFunction
setMode wrapper_fp :: FilePath
wrapper_fp = FilePath -> FileMode -> IO ()
setFileMode FilePath
wrapper_fp FileMode
accessModes
cabalAction :: FilePath -> Maybe String -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions)
cabalAction :: FilePath
-> Maybe FilePath
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
cabalAction work_dir :: FilePath
work_dir mc :: Maybe FilePath
mc l :: LoggingFunction
l fp :: FilePath
fp = do
(FilePath, [FilePath])
-> FilePath
-> (FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall a.
(FilePath, [FilePath]) -> FilePath -> (FilePath -> IO a) -> IO a
withCabalWrapperTool ("ghc", []) FilePath
work_dir ((FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions))
-> (FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ \wrapper_fp :: FilePath
wrapper_fp -> do
let cab_args :: [FilePath]
cab_args = ["v2-repl", "--with-compiler", FilePath
wrapper_fp, FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath
fixTargetPath FilePath
fp) Maybe FilePath
mc]
(ex :: ExitCode
ex, output :: [FilePath]
output, stde :: [FilePath]
stde, args :: [FilePath]
args) <-
LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile LoggingFunction
l FilePath
work_dir (FilePath -> [FilePath] -> CreateProcess
proc "cabal" [FilePath]
cab_args)
case [FilePath] -> Maybe (FilePath, [FilePath])
processCabalWrapperArgs [FilePath]
args of
Nothing -> do
[FilePath]
deps <- FilePath -> FilePath -> IO [FilePath]
cabalCradleDependencies FilePath
work_dir FilePath
work_dir
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult ComponentOptions
forall r. CradleError -> CradleLoadResult r
CradleFail ([FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [FilePath]
deps ExitCode
ex
["Failed to parse result of calling cabal"
, [FilePath] -> FilePath
unlines [FilePath]
output
, [FilePath] -> FilePath
unlines [FilePath]
stde
, [FilePath] -> FilePath
unlines [FilePath]
args])
Just (componentDir :: FilePath
componentDir, final_args :: [FilePath]
final_args) -> do
[FilePath]
deps <- FilePath -> FilePath -> IO [FilePath]
cabalCradleDependencies FilePath
work_dir FilePath
componentDir
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ (ExitCode, [FilePath], FilePath, [FilePath])
-> [FilePath] -> CradleLoadResult ComponentOptions
makeCradleResult (ExitCode
ex, [FilePath]
stde, FilePath
componentDir, [FilePath]
final_args) [FilePath]
deps
where
fixTargetPath :: FilePath -> FilePath
fixTargetPath x :: FilePath
x
| Bool
isWindows Bool -> Bool -> Bool
&& FilePath -> Bool
hasDrive FilePath
x = FilePath -> FilePath -> FilePath
makeRelative FilePath
work_dir FilePath
x
| Bool
otherwise = FilePath
x
removeInteractive :: [String] -> [String]
removeInteractive :: [FilePath] -> [FilePath]
removeInteractive = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "--interactive")
data InRTS = OutsideRTS | InsideRTS
removeRTS :: [String] -> [String]
removeRTS :: [FilePath] -> [FilePath]
removeRTS = InRTS -> [FilePath] -> [FilePath]
go InRTS
OutsideRTS
where
go :: InRTS -> [String] -> [String]
go :: InRTS -> [FilePath] -> [FilePath]
go _ [] = []
go OutsideRTS (y :: FilePath
y:ys :: [FilePath]
ys)
| "+RTS" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
y = InRTS -> [FilePath] -> [FilePath]
go (if "-RTS" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
y then InRTS
OutsideRTS else InRTS
InsideRTS) [FilePath]
ys
| Bool
otherwise = FilePath
y FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: InRTS -> [FilePath] -> [FilePath]
go InRTS
OutsideRTS [FilePath]
ys
go InsideRTS (y :: FilePath
y:ys :: [FilePath]
ys) = InRTS -> [FilePath] -> [FilePath]
go (if "-RTS" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
y then InRTS
OutsideRTS else InRTS
InsideRTS) [FilePath]
ys
removeVerbosityOpts :: [String] -> [String]
removeVerbosityOpts :: [FilePath] -> [FilePath]
removeVerbosityOpts = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (FilePath -> Bool) -> FilePath -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "-v0") (FilePath -> Bool -> Bool)
-> (FilePath -> Bool) -> FilePath -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "-w"))
cabalWorkDir :: FilePath -> MaybeT IO FilePath
cabalWorkDir :: FilePath -> MaybeT IO FilePath
cabalWorkDir wdir :: FilePath
wdir =
(FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "cabal.project") FilePath
wdir
MaybeT IO FilePath -> MaybeT IO FilePath -> MaybeT IO FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards (\fp :: FilePath
fp -> FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".cabal") FilePath
wdir
stackCradle :: FilePath -> Maybe String -> Cradle a
stackCradle :: FilePath -> Maybe FilePath -> Cradle a
stackCradle wdir :: FilePath
wdir mc :: Maybe FilePath
mc =
Cradle :: forall a. FilePath -> CradleAction a -> Cradle a
Cradle
{ cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
, cradleOptsProg :: CradleAction a
cradleOptsProg = CradleAction :: forall a.
ActionName a
-> (LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions))
-> ([FilePath] -> IO (CradleLoadResult FilePath))
-> CradleAction a
CradleAction
{ actionName :: ActionName a
actionName = ActionName a
forall a. ActionName a
Types.Stack
, runCradle :: LoggingFunction
-> FilePath -> IO (CradleLoadResult ComponentOptions)
runCradle = FilePath
-> Maybe FilePath
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
stackAction FilePath
wdir Maybe FilePath
mc
, runGhcCmd :: [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmd = \args :: [FilePath]
args ->
FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> IO (CradleLoadResult FilePath)
readProcessWithCwd
FilePath
wdir "stack" (["exec", "--silent", "ghc", "--"] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
args) ""
}
}
stackCradleDependencies :: FilePath -> FilePath -> IO [FilePath]
stackCradleDependencies :: FilePath -> FilePath -> IO [FilePath]
stackCradleDependencies wdir :: FilePath
wdir componentDir :: FilePath
componentDir = do
let relFp :: FilePath
relFp = FilePath -> FilePath -> FilePath
makeRelative FilePath
wdir FilePath
componentDir
[FilePath]
cabalFiles' <- FilePath -> IO [FilePath]
findCabalFiles FilePath
componentDir
let cabalFiles :: [FilePath]
cabalFiles = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
relFp FilePath -> FilePath -> FilePath
</>) [FilePath]
cabalFiles'
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
normalise ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
cabalFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
relFp FilePath -> FilePath -> FilePath
</> "package.yaml", "stack.yaml"]
stackAction :: FilePath -> Maybe String -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions)
stackAction :: FilePath
-> Maybe FilePath
-> LoggingFunction
-> FilePath
-> IO (CradleLoadResult ComponentOptions)
stackAction work_dir :: FilePath
work_dir mc :: Maybe FilePath
mc l :: LoggingFunction
l _fp :: FilePath
_fp = do
let ghcProcArgs :: (FilePath, [FilePath])
ghcProcArgs = ("stack", ["exec", "ghc", "--"])
(FilePath, [FilePath])
-> FilePath
-> (FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall a.
(FilePath, [FilePath]) -> FilePath -> (FilePath -> IO a) -> IO a
withCabalWrapperTool (FilePath, [FilePath])
ghcProcArgs FilePath
work_dir ((FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions))
-> (FilePath -> IO (CradleLoadResult ComponentOptions))
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ \wrapper_fp :: FilePath
wrapper_fp -> do
(ex1 :: ExitCode
ex1, _stdo :: [FilePath]
_stdo, stde :: [FilePath]
stde, args :: [FilePath]
args) <-
LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile LoggingFunction
l FilePath
work_dir (CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$
FilePath -> [FilePath] -> CreateProcess
proc "stack" ([FilePath] -> CreateProcess) -> [FilePath] -> CreateProcess
forall a b. (a -> b) -> a -> b
$ ["repl", "--no-nix-pure", "--with-ghc", FilePath
wrapper_fp]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
comp | Just comp :: FilePath
comp <- [Maybe FilePath
mc] ]
(ex2 :: ExitCode
ex2, pkg_args :: [FilePath]
pkg_args, stdr :: [FilePath]
stdr, _) <-
LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile LoggingFunction
l FilePath
work_dir (CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$
FilePath -> [FilePath] -> CreateProcess
proc "stack" ["path", "--ghc-package-path"]
let split_pkgs :: [FilePath]
split_pkgs = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
splitSearchPath [FilePath]
pkg_args
pkg_ghc_args :: [FilePath]
pkg_ghc_args = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\p :: FilePath
p -> ["-package-db", FilePath
p] ) [FilePath]
split_pkgs
case [FilePath] -> Maybe (FilePath, [FilePath])
processCabalWrapperArgs [FilePath]
args of
Nothing -> do
[FilePath]
deps <- FilePath -> FilePath -> IO [FilePath]
stackCradleDependencies FilePath
work_dir FilePath
work_dir
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult ComponentOptions
forall r. CradleError -> CradleLoadResult r
CradleFail
([FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [FilePath]
deps ExitCode
ex1 ([FilePath] -> CradleError) -> [FilePath] -> CradleError
forall a b. (a -> b) -> a -> b
$
[ "Failed to parse result of calling stack" ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
stde
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
args
)
Just (componentDir :: FilePath
componentDir, ghc_args :: [FilePath]
ghc_args) -> do
[FilePath]
deps <- FilePath -> FilePath -> IO [FilePath]
stackCradleDependencies FilePath
work_dir FilePath
componentDir
CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions))
-> CradleLoadResult ComponentOptions
-> IO (CradleLoadResult ComponentOptions)
forall a b. (a -> b) -> a -> b
$ (ExitCode, [FilePath], FilePath, [FilePath])
-> [FilePath] -> CradleLoadResult ComponentOptions
makeCradleResult
( [ExitCode] -> ExitCode
combineExitCodes [ExitCode
ex1, ExitCode
ex2]
, [FilePath]
stde [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
stdr, FilePath
componentDir
, [FilePath]
ghc_args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_ghc_args
)
[FilePath]
deps
combineExitCodes :: [ExitCode] -> ExitCode
combineExitCodes :: [ExitCode] -> ExitCode
combineExitCodes = (ExitCode -> ExitCode -> ExitCode)
-> ExitCode -> [ExitCode] -> ExitCode
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ExitCode -> ExitCode -> ExitCode
go ExitCode
ExitSuccess
where
go :: ExitCode -> ExitCode -> ExitCode
go ExitSuccess b :: ExitCode
b = ExitCode
b
go a :: ExitCode
a _ = ExitCode
a
stackExecutable :: MaybeT IO FilePath
stackExecutable :: MaybeT IO FilePath
stackExecutable = IO (Maybe FilePath) -> MaybeT IO FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe FilePath) -> MaybeT IO FilePath)
-> IO (Maybe FilePath) -> MaybeT IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
findExecutable "stack"
stackWorkDir :: FilePath -> MaybeT IO FilePath
stackWorkDir :: FilePath -> MaybeT IO FilePath
stackWorkDir = (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
isStack
where
isStack :: FilePath -> Bool
isStack name :: FilePath
name = FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "stack.yaml"
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards :: (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards p :: FilePath -> Bool
p dir :: FilePath
dir = do
[FilePath]
cnts <-
IO [FilePath] -> MaybeT IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO [FilePath] -> MaybeT IO [FilePath])
-> IO [FilePath] -> MaybeT IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOError -> Maybe [FilePath])
-> ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust
(\(IOError
e :: IOError) -> if IOError -> Bool
isPermissionError IOError
e then [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just [] else Maybe [FilePath]
forall a. Maybe a
Nothing)
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
((FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile FilePath -> Bool
p FilePath
dir)
case [FilePath]
cnts of
[] | FilePath
dir' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir -> FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "No cabal files"
| Bool
otherwise -> (FilePath -> Bool) -> FilePath -> MaybeT IO FilePath
findFileUpwards FilePath -> Bool
p FilePath
dir'
_ : _ -> FilePath -> MaybeT IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
where dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir
findFile :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
findFile p :: FilePath -> Bool
p dir :: FilePath
dir = do
Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
if Bool
b then IO [FilePath]
getFiles IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesPredFileExist else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
getFiles :: IO [FilePath]
getFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
p ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
doesPredFileExist :: FilePath -> IO Bool
doesPredFileExist file :: FilePath
file = FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
readProcessWithOutputFile
:: LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [String], [String], [String])
readProcessWithOutputFile :: LoggingFunction
-> FilePath
-> CreateProcess
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
readProcessWithOutputFile l :: LoggingFunction
l work_dir :: FilePath
work_dir cp :: CreateProcess
cp = do
[(FilePath, FilePath)]
old_env <- IO [(FilePath, FilePath)]
getEnvironment
[(FilePath, FilePath)]
-> (FilePath -> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
forall a. [(FilePath, FilePath)] -> (FilePath -> IO a) -> IO a
withHieBiosOutput [(FilePath, FilePath)]
old_env ((FilePath -> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> (FilePath -> IO (ExitCode, [FilePath], [FilePath], [FilePath]))
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$ \output_file :: FilePath
output_file -> do
let process :: CreateProcess
process = CreateProcess
cp { env :: Maybe [(FilePath, FilePath)]
env = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just
([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath
hieBiosOutput, FilePath
output_file)
(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: ([(FilePath, FilePath)]
-> Maybe [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> Maybe a -> a
fromMaybe [(FilePath, FilePath)]
old_env (CreateProcess -> Maybe [(FilePath, FilePath)]
env CreateProcess
cp)),
cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
work_dir
}
let loggingConduit :: ConduitM ByteString c IO [FilePath]
loggingConduit = (ConduitT ByteString Text IO ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
C.decodeUtf8 ConduitT ByteString Text IO ()
-> ConduitM Text c IO [FilePath]
-> ConduitM ByteString c IO [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitT Text Text IO ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
C.lines ConduitT Text Text IO ()
-> ConduitM Text c IO [FilePath] -> ConduitM Text c IO [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (Element Text -> Bool) -> ConduitT Text Text IO ()
forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> Bool) -> ConduitT seq seq m ()
C.filterE (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\r') ConduitT Text Text IO ()
-> ConduitM Text c IO [FilePath] -> ConduitM Text c IO [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (Text -> FilePath) -> ConduitT Text FilePath IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.map Text -> FilePath
T.unpack ConduitT Text FilePath IO ()
-> ConduitM FilePath c IO [FilePath]
-> ConduitM Text c IO [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| LoggingFunction -> ConduitT FilePath FilePath IO ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> ConduitT a a m ()
C.iterM LoggingFunction
l ConduitT FilePath FilePath IO ()
-> ConduitM FilePath c IO [FilePath]
-> ConduitM FilePath c IO [FilePath]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM FilePath c IO [FilePath]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
C.sinkList)
(ex :: ExitCode
ex, stdo :: [FilePath]
stdo, stde :: [FilePath]
stde) <- CreateProcess
-> ConduitT () ByteString IO ()
-> ConduitT ByteString Void IO [FilePath]
-> ConduitT ByteString Void IO [FilePath]
-> IO (ExitCode, [FilePath], [FilePath])
forall (m :: * -> *) a b.
MonadUnliftIO m =>
CreateProcess
-> ConduitT () ByteString m ()
-> ConduitT ByteString Void m a
-> ConduitT ByteString Void m b
-> m (ExitCode, a, b)
sourceProcessWithStreams CreateProcess
process ConduitT () ByteString IO ()
forall a. Monoid a => a
mempty ConduitT ByteString Void IO [FilePath]
forall c. ConduitM ByteString c IO [FilePath]
loggingConduit ConduitT ByteString Void IO [FilePath]
forall c. ConduitM ByteString c IO [FilePath]
loggingConduit
FilePath
res <- FilePath -> IOMode -> (Handle -> IO FilePath) -> IO FilePath
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
output_file IOMode
ReadMode ((Handle -> IO FilePath) -> IO FilePath)
-> (Handle -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \handle :: Handle
handle -> do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
handle BufferMode
LineBuffering
!FilePath
res <- FilePath -> FilePath
forall a. NFData a => a -> a
force (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO FilePath
hGetContents Handle
handle
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
res
(ExitCode, [FilePath], [FilePath], [FilePath])
-> IO (ExitCode, [FilePath], [FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ex, [FilePath]
stdo, [FilePath]
stde, FilePath -> [FilePath]
lines ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\r') FilePath
res))
where
withHieBiosOutput :: [(String,String)] -> (FilePath -> IO a) -> IO a
withHieBiosOutput :: [(FilePath, FilePath)] -> (FilePath -> IO a) -> IO a
withHieBiosOutput env' :: [(FilePath, FilePath)]
env' action :: FilePath -> IO a
action = do
let mbHieBiosOut :: Maybe FilePath
mbHieBiosOut = FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
hieBiosOutput [(FilePath, FilePath)]
env'
case Maybe FilePath
mbHieBiosOut of
Just file :: FilePath
file@(_:_) -> FilePath -> IO a
action FilePath
file
_ -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile "hie-bios" ((FilePath -> Handle -> IO a) -> IO a)
-> (FilePath -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\ file :: FilePath
file h :: Handle
h -> Handle -> IO ()
hClose Handle
h IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO a
action FilePath
file
hieBiosOutput :: FilePath
hieBiosOutput = "HIE_BIOS_OUTPUT"
makeCradleResult :: (ExitCode, [String], FilePath, [String]) -> [FilePath] -> CradleLoadResult ComponentOptions
makeCradleResult :: (ExitCode, [FilePath], FilePath, [FilePath])
-> [FilePath] -> CradleLoadResult ComponentOptions
makeCradleResult (ex :: ExitCode
ex, err :: [FilePath]
err, componentDir :: FilePath
componentDir, gopts :: [FilePath]
gopts) deps :: [FilePath]
deps =
case ExitCode
ex of
ExitFailure _ -> CradleError -> CradleLoadResult ComponentOptions
forall r. CradleError -> CradleLoadResult r
CradleFail ([FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [FilePath]
deps ExitCode
ex [FilePath]
err)
_ ->
let compOpts :: ComponentOptions
compOpts = [FilePath] -> FilePath -> [FilePath] -> ComponentOptions
ComponentOptions [FilePath]
gopts FilePath
componentDir [FilePath]
deps
in ComponentOptions -> CradleLoadResult ComponentOptions
forall r. r -> CradleLoadResult r
CradleSuccess ComponentOptions
compOpts
runGhcCmdOnPath :: FilePath -> [String] -> IO (CradleLoadResult String)
runGhcCmdOnPath :: FilePath -> [FilePath] -> IO (CradleLoadResult FilePath)
runGhcCmdOnPath wdir :: FilePath
wdir args :: [FilePath]
args = FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> IO (CradleLoadResult FilePath)
readProcessWithCwd FilePath
wdir "ghc" [FilePath]
args ""
readProcessWithCwd :: FilePath -> FilePath -> [String] -> String -> IO (CradleLoadResult String)
readProcessWithCwd :: FilePath
-> FilePath
-> [FilePath]
-> FilePath
-> IO (CradleLoadResult FilePath)
readProcessWithCwd dir :: FilePath
dir cmd :: FilePath
cmd args :: [FilePath]
args stdi :: FilePath
stdi = do
let createProc :: CreateProcess
createProc = (FilePath -> [FilePath] -> CreateProcess
proc FilePath
cmd [FilePath]
args) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir }
Maybe (ExitCode, FilePath, FilePath)
mResult <- IO (ExitCode, FilePath, FilePath)
-> IO (Maybe (ExitCode, FilePath, FilePath))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (IO (ExitCode, FilePath, FilePath)
-> IO (Maybe (ExitCode, FilePath, FilePath)))
-> IO (ExitCode, FilePath, FilePath)
-> IO (Maybe (ExitCode, FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO (ExitCode, FilePath, FilePath)
readCreateProcessWithExitCode CreateProcess
createProc FilePath
stdi
case Maybe (ExitCode, FilePath, FilePath)
mResult of
Just (ExitSuccess, stdo :: FilePath
stdo, _) -> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult FilePath -> IO (CradleLoadResult FilePath))
-> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> CradleLoadResult FilePath
forall r. r -> CradleLoadResult r
CradleSuccess FilePath
stdo
Just (exitCode :: ExitCode
exitCode, stdo :: FilePath
stdo, stde :: FilePath
stde) -> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult FilePath -> IO (CradleLoadResult FilePath))
-> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult FilePath
forall r. CradleError -> CradleLoadResult r
CradleFail (CradleError -> CradleLoadResult FilePath)
-> CradleError -> CradleLoadResult FilePath
forall a b. (a -> b) -> a -> b
$
[FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [] ExitCode
exitCode ["Error when calling " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cmd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords [FilePath]
args, FilePath
stdo, FilePath
stde]
Nothing -> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CradleLoadResult FilePath -> IO (CradleLoadResult FilePath))
-> CradleLoadResult FilePath -> IO (CradleLoadResult FilePath)
forall a b. (a -> b) -> a -> b
$ CradleError -> CradleLoadResult FilePath
forall r. CradleError -> CradleLoadResult r
CradleFail (CradleError -> CradleLoadResult FilePath)
-> CradleError -> CradleLoadResult FilePath
forall a b. (a -> b) -> a -> b
$
[FilePath] -> ExitCode -> [FilePath] -> CradleError
CradleError [] ExitCode
ExitSuccess ["Couldn't execute " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cmd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
unwords [FilePath]
args]