module System.JBI.Commands.Cabal
( Cabal
, CabalMode
, Sandbox
, Nix
) where
import System.JBI.Commands.BuildTool
import System.JBI.Commands.Nix
import System.JBI.Commands.Tool
import System.JBI.Environment
import System.JBI.Tagged
import Control.Applicative (liftA2, (<*>))
import Control.Monad (filterM)
import Data.Bool (bool)
import Data.Maybe (isJust, maybeToList)
import Data.Proxy (Proxy(Proxy))
import Data.Version (Version, makeVersion)
import System.Directory (doesFileExist, getCurrentDirectory, listDirectory,
removeFile)
import System.Exit (ExitCode, die, exitSuccess)
import System.FilePath (takeExtension, (</>))
import System.IO.Error (ioError, isDoesNotExistError, tryIOError)
import qualified Distribution.Package as CPkg
import Distribution.PackageDescription (GenericPackageDescription,
condBenchmarks,
condExecutables,
condLibrary,
condTestSuites)
import qualified Distribution.PackageDescription.Parse as CParse
import Distribution.Verbosity (silent)
#if MIN_VERSION_Cabal (2,0,0)
import Distribution.Types.UnqualComponentName (UnqualComponentName,
unUnqualComponentName)
#endif
data Cabal mode
instance Tool (Cabal mode) where
commandName = "cabal"
instance (CabalMode mode) => BuildTool (Cabal mode) where
canUseCommand = canUseMode
commandProjectRoot = cabalProjectRoot
hasBuildArtifacts = hasModeArtifacts
commandPrepare = cabalPrepare
commandTargets = cabalTargets
commandBuild env cmd = cabalTry env cmd . cabalBuild env cmd
commandRepl env cmd rargs = cabalTry env cmd . cabalRepl env cmd rargs
commandClean = cabalClean
commandTest = liftA2 (<*>) cabalTry cabalTest
commandBench = liftA2 (<*>) cabalTry cabalBench
commandExec = cabalExec
commandRun env cmd = (cabalTry env cmd .) . cabalRun env cmd
commandUpdate = cabalUpdate
cabalTry :: (CabalMode mode) => Env -> Tagged (Cabal mode) CommandPath
-> IO ExitCode -> IO ExitCode
cabalTry env cmd = tryCommand "Command failed, trying to re-configure"
(cabalConfigure env cmd)
instance (CabalMode mode) => NamedTool (Cabal mode) where
prettyName p = "cabal+" ++ modeName (getMode p)
getMode :: proxy (Cabal mode) -> Proxy mode
getMode _ = Proxy
class CabalMode mode where
modeName :: proxy mode -> String
needsMinCabal :: Maybe (Tagged (Cabal mode) Version)
needsMinCabal = Nothing
canUseMode :: Env -> Tagged (Cabal mode) CommandPath -> IO Bool
canUseMode env cp = case needsMinCabal of
Nothing -> return hasGHC
Just mv -> maybe hasGHC (mv <=)
<$> commandVersion (envConfig env) cp
where
hasGHC = isJust (ghc (envTools env))
cabalProjectRoot :: Tagged (Cabal mode) CommandPath
-> IO (Maybe (Tagged (Cabal mode) ProjectRoot))
cabalProjectRoot = withTaggedF go
where
go :: FilePath -> IO (Maybe FilePath)
go _ = recurseUpFindFile isCabalFile
hasModeArtifacts :: Tagged (Cabal mode) ProjectRoot -> IO Bool
cabalPrepare :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalTargets :: Config -> Tagged (Cabal mode) CommandPath
-> IO [Tagged (Cabal mode) ProjectTarget]
cabalTargets _ = withTaggedF go
where
go :: FilePath -> IO [String]
go _ = cabalFileComponents
cabalConfigure :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalBuild :: Env -> Tagged (Cabal mode) CommandPath
-> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
cabalBuild = commandArgTarget "build"
cabalRepl :: Env -> Tagged (Cabal mode) CommandPath
-> Tagged (Cabal mode) Args
-> Maybe (Tagged (Cabal mode) ProjectTarget)
-> IO ExitCode
cabalRepl env cmd rargs = commandArgsTarget ("repl" : ghcArgs) env cmd
where
ghcArgs = ["--ghc-options", unwords (stripTag rargs :: Args)]
cabalClean :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalTest :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalTest = commandArg "test"
cabalBench :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalBench = commandArg "bench"
cabalExec :: Env -> Tagged (Cabal mode) CommandPath -> String -> Args -> IO ExitCode
cabalExec env cmd prog progArgs = commandArgs args env cmd
where
args = "exec" : prog : "--" : progArgs
cabalRun :: Env -> Tagged (Cabal mode) CommandPath -> Tagged (Cabal mode) ProjectTarget
-> Args -> IO ExitCode
cabalRun env cmd prog progArgs = commandArgs args env cmd
where
args = "run" : componentName (stripTag prog) : "--" : progArgs
cabalUpdate :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode
cabalUpdate = commandArg "update"
data Sandbox
instance CabalMode Sandbox where
modeName _ = "sandbox"
needsMinCabal = Just (tag (makeVersion [1,18]))
hasModeArtifacts pr = doesFileExist (stripTag pr </> "cabal.sandbox.config")
cabalPrepare = commandArgs ["sandbox", "init"]
cabalConfigure env cmd = tryConfigure
where
install = commandArgs ["install", "--only-dependencies"
, "--enable-tests", "--enable-benchmarks"]
env cmd
tryInstall = tryCommand "Installation failed; updating index."
(cabalUpdate env cmd)
install
tryConfigure = tryCommand "Configuring failed; checking dependencies"
tryInstall
configure
configure = commandArgs ["configure", "--enable-tests", "--enable-benchmarks"]
env cmd
cabalClean env cmd = commandArg "clean" env cmd
.&&. commandArgs ["sandbox", "delete"] env cmd
data Nix
instance CabalMode Nix where
modeName _ = "nix"
canUseMode env _ = return (has nixShell && has cabal2Nix)
where
has :: (NixSupport -> Maybe (Installed a)) -> Bool
has f = isJust (f (nix (envTools env)))
hasModeArtifacts pr = or <$> mapM (doesFileExist . (stripTag pr </>))
["shell.nix", "default.nix"]
cabalPrepare env _ = case path <$> cabal2Nix (nix (envTools env)) of
Nothing -> die "cabal2Nix required"
Just c2n -> tryRunToFile (envConfig env) "shell.nix" c2n ["--shell", "."]
cabalConfigure env _ = case path <$> nixShell nixEnv of
Nothing -> die "nix-shell required"
Just ns -> do
args <- extraArgs
cArgs <- cabalArgs
tryRunErr
"Configuration failed; you may need to manually enable 'withBenchmarkDepends' or 'doBenchmark' in your shell.nix file."
(tryRun cfg ns (args ++ ["--run", cArgs]))
where
extraArgs = bool [] ["--arg", "doBenchmark", "true"] <$> canBench
nixEnv = nix (envTools env)
cfg = envConfig env
canBench =
case path <$> nixInstantiate nixEnv of
Nothing -> return False
Just ni -> do
res <- tryRunLine cfg (stripTag ni) ["--eval", "--expr", "with import <nixpkgs> {}; haskell.lib ? doBenchmark"]
return $ case res of
Just "true" -> maybe False (>= c2nBenchSupport) (cabal2Nix nixEnv >>= version)
_ -> False
c2nBenchSupport :: Tagged Cabal2Nix Version
c2nBenchSupport = tag (makeVersion [2,6])
cabalArgs = unwords . (["cabal", "configure", "--enable-tests"] ++) . bnchArgs <$> canBench
where
bnchArgs canB
| canB = ["--enable-benchmarks"]
| otherwise = []
cabalClean env cmd = commandArg "clean" env cmd
.&&. rmFile "shell.nix"
.&&. rmFile "default.nix"
where
rmFile file = do
rmStatus <- tryIOError (removeFile file)
case rmStatus of
Left err | not (isDoesNotExistError err) -> ioError err
_ -> exitSuccess
isCabalFile :: FilePath -> Bool
isCabalFile = (== ".cabal") . takeExtension
cabalFileComponents :: IO [String]
cabalFileComponents = do
dir <- getCurrentDirectory
cntns <- map (dir </>) <$> listDirectory dir
files <- filterM doesFileExist cntns
let cabalFiles = filter isCabalFile files
case cabalFiles of
[] -> return []
(c:_) -> getComponents <$> parseCabalFile c
parseCabalFile :: FilePath -> IO GenericPackageDescription
parseCabalFile =
#if MIN_VERSION_Cabal(2,0,0)
CParse.readGenericPackageDescription
#else
CParse.readPackageDescription
#endif
silent
type ComponentName =
#if MIN_VERSION_Cabal (2,0,0)
UnqualComponentName
#else
String
#endif
rawComponentName :: ComponentName -> String
rawComponentName =
#if MIN_VERSION_Cabal (2,0,0)
unUnqualComponentName
#else
id
#endif
packageName :: GenericPackageDescription -> String
packageName =
#if MIN_VERSION_Cabal (2,0,0)
CPkg.unPackageName
#else
(\(CPkg.PackageName nm) -> nm)
#endif
. CPkg.packageName
getComponents :: GenericPackageDescription -> [String]
getComponents gpd = concat
[ getLib
, getType condExecutables "exe"
, getType condTestSuites "test"
, getType condBenchmarks "bench"
]
where
pkgName = packageName gpd
getLib
| isJust (condLibrary gpd) = ["lib:" ++ pkgName]
| otherwise = []
getType f typ = map (\cmp -> typ ++ ':' : rawComponentName (fst cmp)) (f gpd)
commandArgsTarget :: Args -> Env -> Tagged (Cabal mode) CommandPath
-> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
commandArgsTarget args env cmd mt = commandArgs args' env cmd
where
args' = args ++ maybeToList (fmap stripTag mt)
commandArgTarget :: String -> Env -> Tagged (Cabal mode) CommandPath
-> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode
commandArgTarget = commandArgsTarget . (:[])
commandArg :: String -> Env -> Tagged (Cabal mode) CommandPath
-> IO ExitCode
commandArg arg = commandArgs [arg]
commandArgs :: Args -> Env -> Tagged (Cabal mode) CommandPath
-> IO ExitCode
commandArgs args env cmd = tryRun (envConfig env) cmd args