jbi 0.1.0.0 → 0.2.0.0

raw patch · 13 files changed

+448/−183 lines, 13 filesdep +monad-paralleldep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: monad-parallel

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +40/−1
• README.md +24/−0
• jbi.cabal +7/−5
• lib/System/JBI.hs +28/−22
• lib/System/JBI/Commands.hs +26/−25
• lib/System/JBI/Commands/BuildTool.hs +21/−21
• lib/System/JBI/Commands/Cabal.hs +91/−32
• lib/System/JBI/Commands/Nix.hs +17/−10
• lib/System/JBI/Commands/Stack.hs +40/−16
• lib/System/JBI/Commands/Tool.hs +44/−28
• lib/System/JBI/Config.hs +22/−0
• lib/System/JBI/Environment.hs +17/−4
• src/Main.hs +71/−19

@@ -1,5 +1,44 @@ # Revision history for jbi -## 0.1.0.0  -- 2017-09-05+## 0.2.0.0 -- 2018-02-07++* Add a `--version` (and `-V`) flag to the executable.++* `jbi repl` now takes an optional `--repl-opts` which is passed+  through to the underlying REPL (e.g. `ghci`).++    * No longer supply `-ferror-spans` by default.++* A `--debug` argument prints out all commands run.++    This results in _many_ API changes; as a sample:++    * `GlobalEnv` has been renamed to `ToolEnv`+    * A `Config` type is now provided for run-time configuration.+      This is now taken by most of the running commands.+    * `Env` wraps the above two types and is an argument to most+      `BuildTool` commands.++* Try and support benchmarking with `cabal+nix` where possible.++    API change: the `NixSupport` type now contains information about+    `nix-instantiate`.++* Better support for getting targets from stack.++* If a build tool needs the version to check validity it has to+  explicitly obtain it.++    API Changes:++    * Change in `canUseCommand` in `BuildTool` class+    * Change in `command` field in `Valid` data structure+    * Change in `canUseMode` in `CabalMode` class+    * Addition of `needsMinCabal` to `CabalMode` class++* Other small tweaks to reduce the overhead of using _jbi_ over the+  build tool itself (parallel validity checking, etc.).++## 0.1.0.0 -- 2017-09-05  * First version. Released on an semi-suspecting world.

@@ -204,6 +204,30 @@ Run `jbi prepare`.  This is likely the only scenario you will ever need to explicitly run this command in. +### Why don't I have benchmarking support with _cabal+nix_?++Benchmarking using _cabal+nix_ requires support from `nixpkgs`.  This+is currently present in the `unstable` branch but is not yet present+in a release (but should hopefully be found in `18.03`).++You can verify whether your version of `nixpkgs` supports benchmarking+Haskell code with:++```bash+nix-instantiate --eval --expr 'with import <nixpkgs> {}; haskell.lib ? doBenchmark'+```++Note that _jbi_ currently doesn't support specifying which channel you+are using and defaults to `nixpkgs`.  If you are using `unstable` you+can try to manually configure by editing the generated `shell.nix` and+replacing `<nixpkgs>` with `<unstable>` (or whatever you have called+that channel) and running:++```bash+nix-shell --arg doBenchmark true \+  --run 'cabal configure --enable-tests --enable-benchmarks'+```+ ### How do I add a new build tool?  Pull requests are welcome.

@@ -1,5 +1,5 @@ name:                jbi-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Just Build It - a "do what I mean" abstraction for Haskell build tools description:   If you work with multiple Haskell projects, it can be annoying have to@@ -14,12 +14,12 @@ license-file:        LICENSE author:              Ivan Lazar Miljenovic maintainer:          Ivan.Miljenovic@gmail.com--- copyright:+copyright:           Ivan Lazar Miljenovic category:            Development build-type:          Simple extra-source-files:  ChangeLog.md, README.md cabal-version:       >=1.10-tested-with:         GHC == 7.10.2, GHC == 8.0.2, GHC == 8.1.*+tested-with:         GHC == 7.10.2, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.3.*  source-repository head   type:        git@@ -33,14 +33,16 @@                      , System.JBI.Commands.Nix                      , System.JBI.Commands.Stack                      , System.JBI.Commands.Tool+                     , System.JBI.Config                      , System.JBI.Environment                      , System.JBI.Tagged -  build-depends:       base >=4.8 && <4.11+  build-depends:       base >=4.8 && <4.13                      , aeson >= 0.11.1.0 && < 1.3                      , Cabal >= 1.22.0.0 && < 2.1                      , directory >= 1.2.5.0                      , filepath >= 1.4.0.0 && < 1.5+                     , monad-parallel == 0.7.*                      , process >= 1.4.3.0 && < 1.7                      , tagged == 0.8.*   hs-source-dirs:      lib@@ -60,4 +62,4 @@    hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options:         -Wall+  ghc-options:         -Wall -threaded

@@ -19,8 +19,13 @@   , toolName   , infoProjectDir     -- * System state\/environment-  , GlobalEnv(..)-  , globalEnv+  , Env(..)+  , getEnvironment+  , ToolEnv(..)+  , toolEnv+    -- ** Runtime configuration+  , Config(..)+  , defaultConfig     -- * Information\/Diagnostics   , Information (..)   , getInformation@@ -41,15 +46,18 @@ import System.JBI.Commands.BuildTool (ToolInformation) import System.JBI.Commands.Cabal import System.JBI.Commands.Stack+import System.JBI.Config import System.JBI.Environment  import Control.Applicative ((<|>)) import Data.Aeson          (ToJSON) import Data.List           (find)-import Data.Maybe          (listToMaybe)+import Data.Maybe          (catMaybes, listToMaybe) import Data.Proxy          (Proxy(..)) import GHC.Generics        (Generic) +import qualified Control.Monad.Parallel as P+ --------------------------------------------------------------------------------  defaultTools :: [WrappedTool Proxy]@@ -58,34 +66,32 @@                , Wrapped (Proxy :: Proxy (Cabal Sandbox))                ] -withTool :: IO res -> (GlobalEnv -> WrappedTool Valid -> IO res)+withTool :: Config -> IO res+            -> (Env -> WrappedTool Valid -> IO res)             -> [WrappedTool proxy] -> IO res-withTool onFailure f tools = do-  env <- globalEnv+withTool cfg onFailure f tools = do+  env <- getEnvironment cfg   mtool <- chooseTool env tools   maybe onFailure (f env) mtool -chooseTool :: GlobalEnv -> [WrappedTool proxy] -> IO (Maybe (WrappedTool Valid))+chooseTool :: Env -> [WrappedTool proxy] -> IO (Maybe (WrappedTool Valid)) chooseTool env tools = do-  valid <- mapMaybeM (checkValidity env) tools+  valid <- catMaybes <$> P.mapM (checkValidity env) tools   return (find alreadyUsed valid <|> listToMaybe valid)  data Information = Information-  { environment :: !GlobalEnv+  { environment :: !ToolEnv   , toolDetails :: ![WrappedTool ToolInformation]   } deriving (Show, Generic, ToJSON) -getInformation :: [WrappedTool proxy] -> IO Information-getInformation tools = do-  env <- globalEnv-  Information env <$> mapM (toolInformation env) tools------------------------------------------------------------------------------------mapMaybeM :: (a -> IO (Maybe b)) -> [a] -> IO [b]-mapMaybeM f = go+getInformation :: Config -> [WrappedTool proxy] -> IO Information+getInformation cfg tools = do+  tenv <- toolEnv cfg+  Information tenv <$> mapMer (toolInformation (Env cfg tenv)) tools   where-    go []     = return []-    go (a:as) = do-      mb <- f a-      maybe id (:) mb <$> go as+    -- When debugging, output of tool commands get mangled in parallel+    mapMer | debugMode cfg = mapM+           | otherwise     = P.mapM++getEnvironment :: Config -> IO Env+getEnvironment cfg = Env cfg <$> toolEnv cfg

@@ -71,13 +71,14 @@ toolName :: WrappedTool proxy -> String toolName = withWrapped prettyName -toolInformation :: GlobalEnv -> WrappedTool proxy -> IO (WrappedTool ToolInformation)+toolInformation :: Env -> WrappedTool proxy -> IO (WrappedTool ToolInformation) toolInformation env (Wrapped pr) = Wrapped <$> commandToolInformation env pr  --------------------------------------------------------------------------------  data Valid bt = Valid-  { command      :: !(Installed bt)+  { command      :: !(Tagged bt CommandPath)+                    -- ^ @since 0.2.0.0   , projectDir   :: !(Tagged bt ProjectRoot)   , hasArtifacts :: !Bool     -- ^ Only to be used with 'ensurePrepared', 'prepare', 'unprepared'.@@ -90,28 +91,28 @@ infoProjectDir = withWrapped (stripTag . projectDir)  -- This is pretty ugly; one way to clean it up would be to use MaybeT.-checkValidity :: GlobalEnv -> WrappedTool proxy -> IO (Maybe (WrappedTool Valid))+checkValidity :: Env -> WrappedTool proxy -> IO (Maybe (WrappedTool Valid)) checkValidity env (Wrapped p) = fmap Wrapped <$> check p   where     check :: (BuildTool bt) => proxy' bt -> IO (Maybe (Valid bt))     check _ = do-      mInst <- commandInformation-      case mInst of+      mcp <- commandPath+      case mcp of         Nothing   -> return Nothing-        Just inst -> do-          usbl <- canUseCommand env inst+        Just cp -> do+          usbl <- canUseCommand env cp           if not usbl              then return Nothing-             else do mroot <- commandProjectRoot (path inst)+             else do mroot <- commandProjectRoot cp                      forM mroot $ \root ->-                       Valid inst root <$> hasBuildArtifacts root+                       Valid cp root <$> hasBuildArtifacts root  runInProject :: (forall bt. (BuildTool bt) => Tagged bt CommandPath -> IO res)                 -> WrappedTool Valid -> IO res runInProject f (Wrapped val) = withCurrentDirectory (stripTag (projectDir val))-                                                    (f (path (command val)))+                                                    (f (command val)) -prepareWrapped :: GlobalEnv -> WrappedTool Valid -> IO (WrappedTool Valid)+prepareWrapped :: Env -> WrappedTool Valid -> IO (WrappedTool Valid) prepareWrapped env wt@(Wrapped val) = do   ec <- runInProject (commandPrepare env) wt   case ec of@@ -122,8 +123,8 @@          else die "Preparation failed"     _           -> die "Could not prepare" -runPrepared :: (forall bt. (BuildTool bt) => GlobalEnv -> Tagged bt CommandPath -> IO res)-               -> GlobalEnv -> WrappedTool Valid -> IO res+runPrepared :: (forall bt. (BuildTool bt) => Env -> Tagged bt CommandPath -> IO res)+               -> Env -> WrappedTool Valid -> IO res runPrepared f env wv = do   wv' <- if not (alreadyUsed wv)             then prepareWrapped env wv@@ -133,33 +134,33 @@ -------------------------------------------------------------------------------- -- This mimics the actual command-level portion of BuildTool -prepare :: GlobalEnv -> WrappedTool Valid -> IO ExitCode+prepare :: Env -> WrappedTool Valid -> IO ExitCode prepare env wv = prepareWrapped env wv >> return ExitSuccess -- Explicitly prepare. -targets :: GlobalEnv -> WrappedTool Valid -> IO [ProjectTarget]-targets = runPrepared (const (fmap stripTags . commandTargets))+targets :: Env -> WrappedTool Valid -> IO [ProjectTarget]+targets = runPrepared ((fmap stripTags .) . commandTargets . envConfig) -build :: Maybe ProjectTarget -> GlobalEnv -> WrappedTool Valid -> IO ExitCode+build :: Maybe ProjectTarget -> Env -> WrappedTool Valid -> IO ExitCode build targ = runPrepared (\env cp -> commandBuild env cp (tagInner (tag targ))) -repl :: Maybe ProjectTarget -> GlobalEnv -> WrappedTool Valid -> IO ExitCode-repl targ = runPrepared (\env cp -> commandRepl env cp (tagInner (tag targ)))+repl :: Args -> Maybe ProjectTarget -> Env -> WrappedTool Valid -> IO ExitCode+repl rargs targ = runPrepared (\env cp -> commandRepl env cp (Tagged rargs) (tagInner (tag targ))) -clean :: GlobalEnv -> WrappedTool Valid -> IO ExitCode+clean :: Env -> WrappedTool Valid -> IO ExitCode clean = runPrepared commandClean -test :: GlobalEnv -> WrappedTool Valid -> IO ExitCode+test :: Env -> WrappedTool Valid -> IO ExitCode test = runPrepared commandTest -bench :: GlobalEnv -> WrappedTool Valid -> IO ExitCode+bench :: Env -> WrappedTool Valid -> IO ExitCode bench = runPrepared commandBench -exec :: String -> Args -> GlobalEnv -> WrappedTool Valid -> IO ExitCode+exec :: String -> Args -> Env -> WrappedTool Valid -> IO ExitCode exec cmd args = runPrepared (\env cp -> commandExec env cp cmd args) -run :: ProjectTarget -> Args -> GlobalEnv -> WrappedTool Valid -> IO ExitCode+run :: ProjectTarget -> Args -> Env -> WrappedTool Valid -> IO ExitCode run targ args = runPrepared (\env cp -> commandRun env cp (tag targ) args) -update :: GlobalEnv -> WrappedTool Valid -> IO ExitCode+update :: Env -> WrappedTool Valid -> IO ExitCode update = runPrepared commandUpdate

@@ -38,7 +38,9 @@   --   using this tool.   --   --   For example, a minimum version, need another tool installed, etc.-  canUseCommand :: GlobalEnv -> Installed bt -> IO Bool+  --+  --   @since 0.2.0.0+  canUseCommand :: Env -> Tagged bt CommandPath -> IO Bool   canUseCommand _ _ = return True    -- | Try and determine the root directory for this project.@@ -57,49 +59,49 @@   --   Some manual fiddling is allowed after this.   --   --   Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandPrepare :: GlobalEnv -> Tagged bt CommandPath -> IO ExitCode+  commandPrepare :: Env -> Tagged bt CommandPath -> IO ExitCode    -- | Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandTargets :: Tagged bt CommandPath -> IO [Tagged bt ProjectTarget]+  commandTargets :: Config -> Tagged bt CommandPath -> IO [Tagged bt ProjectTarget]    -- | Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandBuild :: GlobalEnv -> Tagged bt CommandPath -> Maybe (Tagged bt ProjectTarget)+  commandBuild :: Env -> Tagged bt CommandPath -> Maybe (Tagged bt ProjectTarget)                   -> IO ExitCode -  -- | Launch a @ghci@ session within the current project.  Should-  --   pass through the @-ferror-spans@ argument to the underlying-  --   ghci process.+  -- | Launch a @ghci@ session within the current project.   --+  --   Takes a list of interpreter arguments.+  --   --   Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandRepl :: GlobalEnv -> Tagged bt CommandPath -> Maybe (Tagged bt ProjectTarget)-                 -> IO ExitCode+  commandRepl :: Env -> Tagged bt CommandPath -> Tagged bt Args+                 -> Maybe (Tagged bt ProjectTarget) -> IO ExitCode    -- | Remove /all/ build artifacts of using this build tool (that is,   --   afterwards 'hasBuildArtifacts' should return 'False').   --   --   Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandClean :: GlobalEnv -> Tagged bt CommandPath -> IO ExitCode+  commandClean :: Env -> Tagged bt CommandPath -> IO ExitCode    -- | Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandTest :: GlobalEnv -> Tagged bt CommandPath -> IO ExitCode+  commandTest :: Env -> Tagged bt CommandPath -> IO ExitCode    -- | Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandBench :: GlobalEnv -> Tagged bt CommandPath -> IO ExitCode+  commandBench :: Env -> Tagged bt CommandPath -> IO ExitCode    -- | Run an external command within this environment.   --   --   Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandExec :: GlobalEnv -> Tagged bt CommandPath -> String -> Args -> IO ExitCode+  commandExec :: Env -> Tagged bt CommandPath -> String -> Args -> IO ExitCode    -- | Run an executable component within this environment (building   --   it first if required).   --   --   Assumes 'canUseBuildTool'.  Should be run within 'ProjectRoot'.-  commandRun :: GlobalEnv -> Tagged bt CommandPath -> Tagged bt ProjectTarget+  commandRun :: Env -> Tagged bt CommandPath -> Tagged bt ProjectTarget                 -> Args -> IO ExitCode    -- | Update index of available packages.-  commandUpdate :: GlobalEnv -> Tagged bt CommandPath -> IO ExitCode+  commandUpdate :: Env -> Tagged bt CommandPath -> IO ExitCode  -- | This class exists because of: --@@ -116,8 +118,7 @@   , information :: !(Maybe (BuildUsage bt))   } deriving (Eq, Show, Read, Generic, ToJSON) -commandToolInformation :: (NamedTool bt)-                          => GlobalEnv -> proxy bt+commandToolInformation :: (NamedTool bt) => Env -> proxy bt                           -> IO (ToolInformation bt) commandToolInformation env pr =   ToolInformation (prettyName pr) <$> commandBuildUsage env@@ -135,13 +136,12 @@  -- | A 'Nothing' indicates that this tool cannot be used for this --   project (i.e. needs configuration).-commandBuildUsage :: (BuildTool bt)-                     => GlobalEnv+commandBuildUsage :: (BuildTool bt) => Env                      -> IO (Maybe (BuildUsage bt)) commandBuildUsage env = do-  mInst <- commandInformation+  mInst <- commandInformation (envConfig env)   forM mInst $ \inst ->-    BuildUsage inst <$> canUseCommand env inst+    BuildUsage inst <$> canUseCommand env (path inst)                     <*> commandBuildProject (path inst)  

@@ -25,9 +25,10 @@  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        (makeVersion)+import Data.Version        (Version, makeVersion) import System.Directory    (doesFileExist, getCurrentDirectory, listDirectory,                             removeFile) import System.Exit         (ExitCode, die, exitSuccess)@@ -68,7 +69,7 @@    commandBuild env cmd = cabalTry env cmd . cabalBuild env cmd -  commandRepl env cmd = cabalTry env cmd . cabalRepl env cmd+  commandRepl env cmd rargs = cabalTry env cmd . cabalRepl env cmd rargs    commandClean = cabalClean @@ -82,7 +83,7 @@    commandUpdate = cabalUpdate -cabalTry :: (CabalMode mode) => GlobalEnv -> Tagged (Cabal mode) CommandPath+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)@@ -96,8 +97,22 @@ class CabalMode mode where   modeName :: proxy mode -> String -  canUseMode :: GlobalEnv -> Installed (Cabal mode) -> IO Bool+  -- | Optional minimal version of @cabal@ required.  Used to provide+  --   default instance of @canUseMode@.+  --+  --   @since 0.2.0.0+  needsMinCabal :: Maybe (Tagged (Cabal mode) Version)+  needsMinCabal = Nothing +  -- | @since 0.2.0.0+  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@@ -109,11 +124,11 @@    hasModeArtifacts :: Tagged (Cabal mode) ProjectRoot -> IO Bool -  cabalPrepare :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalPrepare :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode -  cabalTargets :: Tagged (Cabal mode) CommandPath+  cabalTargets :: Config -> Tagged (Cabal mode) CommandPath                   -> IO [Tagged (Cabal mode) ProjectTarget]-  cabalTargets = withTaggedF go+  cabalTargets _ = withTaggedF go     where       -- Make withTaggedF happy       go :: FilePath -> IO [String]@@ -121,36 +136,40 @@    -- | This is an additional function than found in 'BuildTool'.  May   --   include installing dependencies.-  cabalConfigure :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalConfigure :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode -  cabalBuild :: GlobalEnv -> Tagged (Cabal mode) CommandPath-                  -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode+  cabalBuild :: Env -> Tagged (Cabal mode) CommandPath+                -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode   cabalBuild = commandArgTarget "build" -  cabalRepl :: GlobalEnv -> Tagged (Cabal mode) CommandPath-               -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode-  cabalRepl = commandArgsTarget ["repl", "--ghc-options=-ferror-spans"]+  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 :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalClean :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode -  cabalTest :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalTest :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode   cabalTest = commandArg "test" -  cabalBench :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalBench :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode   cabalBench = commandArg "bench" -  cabalExec :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> String -> Args -> IO ExitCode+  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 :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> Tagged (Cabal mode) ProjectTarget+  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 :: GlobalEnv -> Tagged (Cabal mode) CommandPath -> IO ExitCode+  cabalUpdate :: Env -> Tagged (Cabal mode) CommandPath -> IO ExitCode   cabalUpdate = commandArg "update"  --------------------------------------------------------------------------------@@ -160,9 +179,7 @@ instance CabalMode Sandbox where   modeName _ = "sandbox" -  canUseMode env inst = return (isJust (ghc env)-                                && maybe True ((>= makeVersion [1,18]) . stripTag)-                                              (version inst))+  needsMinCabal = Just (tag (makeVersion [1,18]))    hasModeArtifacts pr = doesFileExist (stripTag pr </> "cabal.sandbox.config") @@ -197,20 +214,62 @@ instance CabalMode Nix where   modeName _ = "nix" -  canUseMode env _ = return (liftA2 (&&) (isJust . nixShell) (isJust . cabal2Nix) (nix env))+  -- We don't test for nix-instantiate here, as it's just used if it+  -- can be used.+  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"]    -- Note that commandPrepare is meant to be run within ProjectRoot-  cabalPrepare env _ = case path <$> cabal2Nix (nix env) of+  cabalPrepare env _ = case path <$> cabal2Nix (nix (envTools env)) of                          Nothing  -> die "cabal2Nix required"-                         Just c2n -> tryRunToFile "shell.nix" c2n ["--shell", "."]+                         Just c2n -> tryRunToFile (envConfig env) "shell.nix" c2n ["--shell", "."] -  cabalConfigure env _ = case path <$> nixShell (nix env) of+  -- It is tempting to want to run cabal2nix again here just in case,+  -- but people might have customised variants (different+  -- haskellPackages set, etc.).+  --+  -- Instead, people need to run @jbi prepare@ if the .cabal file+  -- changes.+  cabalConfigure env _ = case path <$> nixShell nixEnv of                            Nothing -> die "nix-shell required"-                           Just ns -> tryRun ns ["--run", "cabal configure --enable-tests --enable-benchmarks"]+                           Just ns -> do+                             -- We now evaluate canBench twice, which isn't ideal.+                             --+                             -- Should also warn if it's False.+                             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"@@ -293,20 +352,20 @@  -------------------------------------------------------------------------------- -commandArgsTarget :: Args -> GlobalEnv -> Tagged (Cabal mode) CommandPath+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 -> GlobalEnv -> Tagged (Cabal mode) CommandPath+commandArgTarget :: String -> Env -> Tagged (Cabal mode) CommandPath                     -> Maybe (Tagged (Cabal mode) ProjectTarget) -> IO ExitCode commandArgTarget = commandArgsTarget . (:[]) -commandArg :: String -> GlobalEnv -> Tagged (Cabal mode) CommandPath+commandArg :: String -> Env -> Tagged (Cabal mode) CommandPath               -> IO ExitCode commandArg arg = commandArgs [arg] -commandArgs :: Args -> GlobalEnv -> Tagged (Cabal mode) CommandPath+commandArgs :: Args -> Env -> Tagged (Cabal mode) CommandPath                -> IO ExitCode-commandArgs args _env cmd = tryRun cmd args+commandArgs args env cmd = tryRun (envConfig env) cmd args

@@ -13,23 +13,25 @@ module System.JBI.Commands.Nix where  import System.JBI.Commands.Tool+import System.JBI.Config        (Config) import System.JBI.Tagged -import Control.Applicative (liftA2)-import Data.Aeson          (ToJSON)-import Data.Char           (isSpace)-import GHC.Generics        (Generic)+import Data.Aeson   (ToJSON)+import Data.Char    (isSpace)+import GHC.Generics (Generic)  --------------------------------------------------------------------------------  data NixSupport = NixSupport-  { nixShell  :: !(Maybe (Installed NixShell))-  , cabal2Nix :: !(Maybe (Installed Cabal2Nix))+  { nixShell       :: !(Maybe (Installed NixShell))+  , cabal2Nix      :: !(Maybe (Installed Cabal2Nix))+  , nixInstantiate :: !(Maybe (Installed NixInstantiate))   } deriving (Eq, Ord, Show, Read, Generic, ToJSON) -findNixSupport :: IO NixSupport-findNixSupport = liftA2 NixSupport commandInformation-                                   commandInformation+findNixSupport :: Config -> IO NixSupport+findNixSupport cfg = NixSupport <$> commandInformation cfg+                                <*> commandInformation cfg+                                <*> commandInformation cfg  data NixShell @@ -41,8 +43,13 @@ instance Tool Cabal2Nix where   commandName = "cabal2nix" -  commandVersion = withTaggedF (tryFindVersionBy getVer)+  commandVersion = withTaggedF . tryFindVersionBy getVer     where       -- There's a digit in the command name, so the naive approach       -- doesn't work.       getVer = takeVersion . drop 1 . dropWhile (not . isSpace)++data NixInstantiate++instance Tool NixInstantiate where+  commandName = "nix-instantiate"

@@ -17,10 +17,12 @@ import System.JBI.Environment import System.JBI.Tagged -import Data.Maybe       (isJust, maybeToList)-import System.Directory (doesDirectoryExist)-import System.Exit      (ExitCode)-import System.FilePath  ((</>))+import Control.Applicative (liftA2)+import Data.Char           (isSpace)+import Data.Maybe          (isJust, maybeToList)+import System.Directory    (doesDirectoryExist)+import System.Exit         (ExitCode)+import System.FilePath     ((</>))  -------------------------------------------------------------------------------- @@ -34,21 +36,35 @@   commandProjectRoot = withTaggedF go     where       go :: FilePath -> IO (Maybe FilePath)-      go _ = recurseUpFindFile (== "stack.yaml")+      go _ = recurseUpFindFile (== stackYaml)    hasBuildArtifacts dir = doesDirectoryExist (stripTag dir </> ".stack-work")    commandPrepare env cmd = commandArg "setup" env cmd                            .&&. commandArgs ["build", "--dry-run"] env cmd -  commandTargets = withTaggedF go+  commandTargets cfg = withTaggedF go     where-      go cmd = maybe [] lines <$> tryRunOutput cmd ["ide", "targets"]+      go cmd = maybe [] validTargets <$> tryRunOutput cfg cmd ["ide", "targets"] +      validTargets = filter isTarget . lines++      isTarget = liftA2 (&&) (not . null) (all (not . isSpace))+   commandBuild = commandArgsTarget ["build", "--test", "--no-run-tests", "--bench", "--no-run-benchmarks"] -  commandRepl = commandArgsTarget ["ghci", "--ghci-options=-ferror-spans", "--test", "--bench", "--no-load"]+  commandRepl env cmd rargs = commandArgsTarget stackArgs env cmd+    where+      stackArgs = [ "ghci"+                  , "--ghci-options"+                  , ghcArgs+                  , "--test"+                  , "--bench"+                  , "--no-load"+                  ] +      ghcArgs = unwords (stripTag rargs :: Args)+   commandClean = commandArgs ["clean", "--full"]    commandTest = commandArg "test"@@ -70,22 +86,30 @@  instance NamedTool Stack -commandArgsTarget :: Args -> GlobalEnv -> Tagged Stack CommandPath+stackYaml :: String+stackYaml = "stack.yaml"++commandArgsTarget :: Args -> Env -> Tagged Stack CommandPath                      -> Maybe (Tagged Stack ProjectTarget) -> IO ExitCode commandArgsTarget args env cmd mt = commandArgs args' env cmd   where     args' = args ++ maybeToList (fmap stripTag mt) -commandArg :: String -> GlobalEnv -> Tagged Stack CommandPath+commandArg :: String -> Env -> Tagged Stack CommandPath               -> IO ExitCode commandArg arg = commandArgs [arg] -commandArgs :: Args -> GlobalEnv -> Tagged Stack CommandPath+commandArgs :: Args -> Env -> Tagged Stack CommandPath                -> IO ExitCode-commandArgs args env cmd = tryRun cmd args'+commandArgs args env cmd = tryRun (envConfig env) cmd args'   where-    hasNix = isJust (nixShell (nix env))+    hasNix = isJust (nixShell (nix (envTools env))) -    args'-      | hasNix    = "--nix" : args-      | otherwise = args+    -- Take advantage of the fact that we're running in the same+    -- directory as the stack.yaml file so that stack doesn't have to+    -- bother looking for it.+    args' = addNix (["--stack-yaml", stackYaml] ++ args)++    addNix+      | hasNix    = ("--nix":)+      | otherwise = id

@@ -12,9 +12,11 @@  -} module System.JBI.Commands.Tool where +import System.JBI.Config import System.JBI.Tagged  import Control.Applicative          (liftA2)+import Control.Monad                (when) import Data.Aeson                   (ToJSON(toJSON)) import Data.Char                    (isDigit) import Data.Maybe                   (listToMaybe)@@ -23,10 +25,12 @@ import GHC.Generics                 (Generic) import System.Directory             (findExecutable) import System.Exit                  (ExitCode(ExitSuccess))-import System.IO                    (IOMode(WriteMode), withFile)+import System.IO                    (IOMode(WriteMode), hPutStrLn, stderr,+                                     withFile) import System.Process               (CreateProcess(..),                                      StdStream(Inherit, UseHandle), proc,-                                     readProcessWithExitCode, waitForProcess,+                                     readProcessWithExitCode,+                                     showCommandForUser, waitForProcess,                                      withCreateProcess) import Text.ParserCombinators.ReadP (eof, readP_to_S) @@ -35,17 +39,17 @@ class Tool t where   commandName :: Tagged t CommandName -  commandVersion :: Tagged t CommandPath -> IO (Maybe (Tagged t Version))-  commandVersion = withTaggedF tryFindVersion+  commandVersion :: Config -> Tagged t CommandPath -> IO (Maybe (Tagged t Version))+  commandVersion = withTaggedF . tryFindVersion  commandPath :: (Tool t) => IO (Maybe (Tagged t CommandPath)) commandPath = withTaggedF findExecutable commandName -commandInformation :: (Tool t) => IO (Maybe (Installed t))-commandInformation = commandPath >>= mapM getVersion+commandInformation :: (Tool t) => Config -> IO (Maybe (Installed t))+commandInformation cfg = commandPath >>= mapM getVersion   where     getVersion :: (Tool t') => Tagged t' CommandPath -> IO (Installed t')-    getVersion tcp = Installed tcp <$> commandVersion tcp+    getVersion tcp = Installed tcp <$> commandVersion cfg tcp  data GHC @@ -81,7 +85,7 @@ -- | Attempt to find the version of the provided command, by assuming --   it's contained in the first line of the output of @command --   --version@.-tryFindVersion :: FilePath -> IO (Maybe Version)+tryFindVersion :: Config -> FilePath -> IO (Maybe Version) tryFindVersion = tryFindVersionBy findVersion   where     findVersion str = takeVersion (dropWhile (not . isDigit) str)@@ -90,9 +94,9 @@ takeVersion :: String -> String takeVersion = takeWhile (liftA2 (||) isDigit (=='.')) -tryFindVersionBy :: (String -> String) -> FilePath -> IO (Maybe Version)-tryFindVersionBy findVersion cmd =-  fmap (>>= parseVer) (tryRunOutput cmd ["--version"])+tryFindVersionBy :: (String -> String) -> Config -> FilePath -> IO (Maybe Version)+tryFindVersionBy findVersion cfg cmd =+  fmap (>>= parseVer) (tryRunOutput cfg cmd ["--version"])   where     parseVer ver = case readP_to_S (parseVersion <* eof) (findVersion ver) of                      [(v,"")] -> Just v@@ -101,8 +105,9 @@ type Args = [String]  -- | Only return the stdout if the process was successful and had no stderr.-tryRunOutput :: FilePath -> Args -> IO (Maybe String)-tryRunOutput cmd args = do+tryRunOutput :: Config -> FilePath -> Args -> IO (Maybe String)+tryRunOutput cfg cmd args = do+  printDebug cfg cmd args   res <- readProcessWithExitCode cmd args ""   return $ case res of              (ExitSuccess, out, "" ) -> Just out@@ -111,13 +116,15 @@              _                       -> Nothing  -- | As with 'tryRunOutput' but only return the first line (if any).-tryRunLine :: FilePath -> Args -> IO (Maybe String)-tryRunLine cmd = fmap (>>= listToMaybe . lines) . tryRunOutput cmd+tryRunLine :: Config -> FilePath -> Args -> IO (Maybe String)+tryRunLine cfg cmd = fmap (>>= listToMaybe . lines) . tryRunOutput cfg cmd  -- | Returns success of call.-tryRun :: Tagged t CommandPath -> Args -> IO ExitCode-tryRun cmd args = withCreateProcess cp $ \_ _ _ ph ->-                    waitForProcess ph+tryRun :: Config -> Tagged t CommandPath -> Args -> IO ExitCode+tryRun cfg cmd args = do+  printDebug cfg cmd' args+  withCreateProcess cp $ \_ _ _ ph ->+    waitForProcess ph   where     cmd' = stripTag cmd @@ -126,10 +133,20 @@                           , std_err = Inherit                           } -tryRunToFile :: FilePath -> Tagged t CommandPath -> Args -> IO ExitCode-tryRunToFile file cmd args = withFile file WriteMode $ \h ->-                               withCreateProcess (cp h) $ \_ _ _ ph ->-                                 waitForProcess ph+-- | Print the error message if it isn't successful.+tryRunErr :: String -> IO ExitCode -> IO ExitCode+tryRunErr msg act = do+  res <- act+  if res == ExitSuccess+     then return res+     else res <$ hPutStrLn stderr msg++tryRunToFile :: Config -> FilePath -> Tagged t CommandPath -> Args -> IO ExitCode+tryRunToFile cfg file cmd args = do+  printDebug cfg cmd' args+  withFile file WriteMode $ \h ->+    withCreateProcess (cp h) $ \_ _ _ ph ->+      waitForProcess ph   where     cmd' = stripTag cmd @@ -138,12 +155,11 @@                             , std_err = Inherit                             } --- | Equivalent to chaining all the calls with @&&@ in bash, etc.------   Argument order to make it easier to feed it into a 'Tagged'-based---   pipeline.-tryRunAll :: [Args] -> Tagged t CommandPath -> IO ExitCode-tryRunAll argss cmd = allSuccess $ map (tryRun cmd) argss+printDebug :: Config -> FilePath -> Args -> IO ()+printDebug cfg cmd args =+  when (debugMode cfg) (hPutStrLn stderr (makeBox ("Running: " ++ cmdStr)))+  where+    cmdStr = showCommandForUser cmd args  (.&&.) :: (Monad m) => m ExitCode -> m ExitCode -> m ExitCode m1 .&&. m2 = do ec1 <- m1

@@ -0,0 +1,22 @@+{- |+   Module      : System.JBI.Config+   Description : Run-time configuration settings+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : MIT+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module System.JBI.Config where++--------------------------------------------------------------------------------++newtype Config = Config+  { debugMode :: Bool+  } deriving (Eq, Show, Read)++defaultConfig :: Config+defaultConfig = Config+  { debugMode = False+  }

@@ -12,20 +12,33 @@    working directories, etc.).   -}-module System.JBI.Environment where+module System.JBI.Environment+  ( Env(..)+  , Config(..)+  , ToolEnv(..)+  , toolEnv+  ) where  import System.JBI.Commands.Nix import System.JBI.Commands.Tool+import System.JBI.Config  import Data.Aeson   (ToJSON) import GHC.Generics (Generic)  -------------------------------------------------------------------------------- -data GlobalEnv = GlobalEnv+data Env = Env+  { envConfig :: !Config+  , envTools  :: !ToolEnv+  } deriving (Eq, Show, Read)++--------------------------------------------------------------------------------++data ToolEnv = ToolEnv   { nix :: NixSupport   , ghc :: Maybe (Installed GHC)   } deriving (Eq, Show, Read, Generic, ToJSON) -globalEnv :: IO GlobalEnv-globalEnv = GlobalEnv <$> findNixSupport <*> commandInformation+toolEnv :: Config -> IO ToolEnv+toolEnv cfg = ToolEnv <$> findNixSupport cfg <*> commandInformation cfg

@@ -23,22 +23,31 @@ import Data.Text.Lazy.Builder   (toLazyText) import Data.Version             (showVersion) import Options.Applicative      (Parser, ParserInfo, argument, command,-                                 execParser, footer, fullDesc, header, help,-                                 helper, hsubparser, info, metavar, progDesc,-                                 str, strArgument)+                                 eitherReader, execParser, flag', footer,+                                 fullDesc, header, help, helper, hsubparser,+                                 info, long, metavar, option, progDesc, short,+                                 str, strArgument, switch) import System.Exit              (ExitCode(ExitSuccess), die, exitWith) +import Text.ParserCombinators.ReadP (ReadP, char, eof, get, munch1, readP_to_S,+                                     satisfy, skipSpaces)+ --------------------------------------------------------------------------------  main :: IO ()-main = execParser parser >>= runCommand defaultTools+main = execParser parser >>= runAction defaultTools +data Action = Action+  { actConfig  :: !Config+  , actCommand :: !Command+  } deriving (Eq, Show, Read)+ --------------------------------------------------------------------------------  data Command = Prepare              | Targets              | Build (Maybe ProjectTarget)-             | REPL  (Maybe ProjectTarget)+             | REPL  Args (Maybe ProjectTarget)              | Clean              | Test              | Bench@@ -46,6 +55,7 @@              | Run ProjectTarget Args              | Update              | Info InfoType+             | Version   deriving (Eq, Show, Read)  data InfoType = AvailableTools@@ -54,15 +64,24 @@               | Detailed               deriving (Eq, Show, Read) -parser :: ParserInfo Command-parser = info (helper <*> parseCommand) $+parser :: ParserInfo Action+parser = info (helper <*> prs) $      header versionInfo   <> fullDesc   <> footer "No arguments is equivalent to running `build`"+  where+    prs = Action <$> parseConfig <*> parseCommand  versionInfo :: String versionInfo = "jbi " ++ showVersion version ++ " - Just Build It and Hack On!" +parseConfig :: Parser Config+parseConfig = Config <$> parseDebug+  where+    parseDebug = switch (   long "debug"+                         <> help "Print debugging information whilst running."+                        )+ parseCommand :: Parser Command parseCommand = (hsubparser . mconcat $   [ command "prepare" (info (pure Prepare)@@ -72,7 +91,7 @@                             (progDesc "Print available targets"))   , command "build"   (info (Build <$> optional parseTarget)                             (progDesc "Build the project (optionally a specified target)."))-  , command "repl"    (info (REPL <$> optional parseTarget)+  , command "repl"    (info (REPL <$> parseReplArgs <*> optional parseTarget)                             (progDesc "Start a REPL.  Passing in a target is optional, but \                                       \highly recommended when multiple targets are available."))   , command "clean"   (info (pure Clean)@@ -90,6 +109,7 @@   , command "info"    (info (Info <$> parseInfo)                             (progDesc "Build tool information; useful for debugging."))   ])+  <|> flag' Version (long "version" <> short 'V')   <|> pure (Build Nothing)  parseTarget :: Parser ProjectTarget@@ -107,6 +127,33 @@                                <> help "Optional arguments to pass through to the command"                               )) +parseReplArgs :: Parser Args+parseReplArgs = concat <$> many (option readArgs (   long "repl-opts"+                                                  <> metavar "ARGS"+                                                  <> help "Optional arguments to pass through to the REPL."+                                                 ))+  where+    readArgs = eitherReader $ \inp ->+      case readP_to_S parseSubArgs inp of+        [(args,"")] -> Right args+        []          -> Left "No ARGS parseable"+        _           -> Left "Ambiguous parse of ARGS"++-- Based upon Data.Attoparsec.Args.argsParser from stack+--+-- Using ReadP to avoid bringing in a parsing library for this one+-- small task.+parseSubArgs :: ReadP Args+parseSubArgs = many (skipSpaces *> (quoted <|> unquoted) <* skipSpaces)+               <* (eof <|> fail "Unterminated string")+  where+    -- munch1 is greedier than (many1 . satisfy)+    unquoted = munch1 (not . flip elem ['"', ' '])+    quoted = char '"' *> string <* char '"'+    string = many (escaped <|> nonquote)+    escaped = char '\\' *> get+    nonquote = satisfy (/='"')+ parseInfo :: Parser InfoType parseInfo = hsubparser . mconcat $   [ command "tools"   (info (pure AvailableTools)@@ -121,12 +168,12 @@  -------------------------------------------------------------------------------- -runCommand :: [WrappedTool proxy] -> Command -> IO ()-runCommand tools cmd = do-  ec <- case cmd of+runAction :: [WrappedTool proxy] -> Action -> IO ()+runAction tools act = do+  ec <- case actCommand act of           Prepare       -> tooled prepare           Build mt      -> tooled (build mt)-          REPL mt       -> tooled (repl mt)+          REPL args mt  -> tooled (repl args mt)           Clean         -> tooled clean           Test          -> tooled test           Bench         -> tooled bench@@ -135,21 +182,24 @@           Update        -> tooled update           Targets       -> printSuccess printTargets           Info it       -> printSuccess (printInfo it)+          Version       -> putStrLn versionInfo >> returnSuccess   exitWith ec   where-    tooled :: (GlobalEnv -> WrappedTool Valid -> IO a) -> IO a-    tooled f = withTool toolFail f tools+    tooled :: (Env -> WrappedTool Valid -> IO a) -> IO a+    tooled f = withTool cfg toolFail f tools      toolFail :: IO a     toolFail = die "No possible tool found." -    printSuccess act = do out <- act-                          putStrLn out-                          return ExitSuccess+    returnSuccess = return ExitSuccess +    printSuccess ma = do out <- ma+                         putStrLn out+                         returnSuccess+     printTargets = tooled ((fmap (multiLine . map projectTarget) .) . targets) -    withChosen f = do env <- globalEnv+    withChosen f = do env <- getEnvironment cfg                       mTool <- chooseTool env tools                       maybe toolFail (return . f) mTool @@ -158,7 +208,9 @@     printInfo AvailableTools = return . multiLine . map toolName $ tools     printInfo ChosenTool     = withChosen toolName     printInfo ProjectDir     = withChosen (rootPath . infoProjectDir)-    printInfo Detailed       = jsonStr <$> getInformation tools+    printInfo Detailed       = jsonStr <$> getInformation cfg tools++    cfg = actConfig act  -- Unlike unlines, this doesn't add a trailing newline. multiLine :: [String] -> String