b9 0.5.68 → 0.5.68.1

raw patch · 9 files changed

+311/−447 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• b9.cabal +2/−1
• src/cli/Main.hs +120/−238
• src/lib/B9.hs +7/−4
• src/lib/B9/B9Config.hs +121/−194
• src/lib/B9/BuildInfo.hs +1/−1
• src/lib/B9/Environment.hs +9/−8
• src/tests/B9/EnvironmentSpec.hs +36/−0
• stack.yaml +1/−1

@@ -1,5 +1,19 @@ # Changelog for B9 +## 0.5.68.1++* Fix positional argument enumeration in the `Enviromnent`; CLI arguments +  are passed via the keys `arg_1 .. arg_N` in the `Environment`.+  They are currently passed in reverse order and start from `arg_0` +  instead of `arg_1`. See github issues #6 and #9.++* Fix #7 shared image meta info download and +  generalize and simplify `B9ConfigOverrid` while at it.++* Remove `Trying to load config file` messages++* Fix #8 - resurrect the environment variable `buildDirRoot`. + ## 0.5.68  * Allow version specific config file resolution

@@ -1,6 +1,6 @@ cabal-version:     2.2 name:                b9-version:             0.5.68+version:             0.5.68.1  synopsis:            A tool and library for building virtual machine images. @@ -198,6 +198,7 @@                    , B9.Content.YamlObjectSpec                    , B9.ArtifactGeneratorImplSpec                    , B9.DiskImagesSpec+                   , B9.EnvironmentSpec                    , Paths_b9   build-depends:     b9                    , binary >= 0.8 && < 0.9

@@ -1,16 +1,11 @@ module Main   ( main-  )-where+  ) where  import           B9-import           Control.Lens                   ( (&)-                                                , (.~)-                                                , (^.)-                                                )-import           Options.Applicative     hiding ( action )-import           Options.Applicative.Help.Pretty-                                         hiding ( (</>) )+import           Control.Lens                    (set, (&), (.~), _Just)+import           Options.Applicative             hiding (action)+import           Options.Applicative.Help.Pretty hiding ((</>))  main :: IO () main = do@@ -29,259 +24,146 @@  applyB9RunParameters :: B9RunParameters -> IO () applyB9RunParameters (B9RunParameters overrides act vars) =-  let cfg =-          noB9ConfigOverride-            &  customLibVirtNetwork-            .~ (overrides ^. customLibVirtNetwork)-            &  maybe id overrideB9ConfigPath (overrides ^. customB9ConfigPath)-            &  customEnvironment-            .~ vars-  in  runB9ConfigActionWithOverrides act cfg+  let cfg = overrides & customEnvironment .~ vars+   in runB9ConfigActionWithOverrides act cfg  parseCommandLine :: IO B9RunParameters-parseCommandLine = execParser-  (info-    (helper <*> (B9RunParameters <$> globals <*> cmds <*> buildVars))-    (  fullDesc-    <> progDesc-         "Build and run VM-Images inside LXC containers. Custom arguments follow after '--' and are accessable in many strings in build files  trough shell like variable references, i.e. '${arg_N}' referes to positional argument $N.\n\nRepository names passed to the command line are looked up in the B9 configuration file, which is per default located in: '~/.b9/b9.conf'. The current working directory is used as ${projectRoot} if not otherwise specified in the config file, or via the '-b' option."-    <> headerDoc (Just b9HelpHeader)-    )-  )- where-  b9HelpHeader = linebreak-    <> text ("B9 - a benign VM-Image build tool v. " ++ b9VersionString)+parseCommandLine =+  execParser+    (info+       (helper <*> (B9RunParameters <$> globals <*> cmds <*> buildVars))+       (fullDesc <>+        progDesc+          "Build and run VM-Images inside LXC containers. Custom arguments follow after '--' and are accessable in many strings in build files  trough shell like variable references, i.e. '${arg_N}' referes to positional argument $N.\n\nRepository names passed to the command line are looked up in the B9 configuration file, which is per default located in: '~/.b9/b9.conf'. The current working directory is used as ${projectRoot} if not otherwise specified in the config file, or via the '-b' option." <>+        headerDoc (Just b9HelpHeader)))+  where+    b9HelpHeader = linebreak <> text ("B9 - a benign VM-Image build tool v. " ++ b9VersionString)  globals :: Parser B9ConfigOverride globals =-  toGlobalOpts-    <$> optional-          (strOption-            (  help "Path to user's b9-configuration (default: ~/.b9/b9.conf)"-            <> short 'c'-            <> long "configuration-file"-            <> metavar "FILENAME"-            )-          )-    <*> switch-          (help "Log everything that happens to stdout" <> short 'v' <> long-            "verbose"-          )-    <*> switch (help "Suppress non-error output" <> short 'q' <> long "quiet")-    <*> optional-          (strOption-            (help "Path to a logfile" <> short 'l' <> long "log-file" <> metavar-              "FILENAME"-            )-          )-    <*> optional-          (strOption-            (  help-                "Root directory for build directories. If not specified '.'. The path will be canonicalized and stored in ${projectRoot}."-            <> short 'b'-            <> long "build-root-dir"-            <> metavar "DIRECTORY"-            )-          )-    <*> switch-          (help "Keep build directories after exit" <> short 'k' <> long-            "keep-build-dir"-          )-    <*> switch-          (help "Predictable build directory names" <> short 'u' <> long-            "predictable-build-dir"-          )-    <*> optional-          (strOption-            (  help-                "Cache directory for shared images, default: '~/.b9/repo-cache'"-            <> long "repo-cache"-            <> metavar "DIRECTORY"-            )-          )-    <*> optional-          (strOption-            (  help "Remote repository to share image to"-            <> short 'r'-            <> long "repo"-            <> metavar "REPOSITORY_ID"-            )-          )-    <*> optional-          (strOption-            (  help-                ("Override the libvirt-lxc network setting.\nThe special value '"-                ++ hostNetworkMagicValue-                ++ "' disables restricted container networking."-                )-            <> long "network"-            <> metavar "NETWORK_ID"-            )-          )- where-  toGlobalOpts-    :: Maybe FilePath-    -> Bool-    -> Bool-    -> Maybe FilePath-    -> Maybe FilePath-    -> Bool-    -> Bool-    -> Maybe FilePath-    -> Maybe String-    -> Maybe String-    -> B9ConfigOverride-  toGlobalOpts cfg verbose quiet logF buildRoot keep predictableBuildDir mRepoCache repo libvirtNet-    = let-        minLogLevel | verbose   = Just LogTrace-                    | quiet     = Just LogError-                    | otherwise = Nothing-        b9cfg =-          mempty-            &  verbosity-            .~ minLogLevel-            &  logFile-            .~ logF-            &  projectRoot-            .~ buildRoot-            &  keepTempDirs-            .~ keep-            &  uniqueBuildDirs-            .~ not predictableBuildDir-            &  repository-            .~ repo-            &  repositoryCache-            .~ (Path <$> mRepoCache)-      in-        B9ConfigOverride-          { _customB9ConfigPath   = Path <$> cfg-          , _customB9Config       = b9cfg-          , _customLibVirtNetwork =-            (\n -> if n == hostNetworkMagicValue then Nothing else Just n)-              <$> libvirtNet-          , _customEnvironment    = mempty-          }+  toGlobalOpts <$>+  optional+    (strOption+       (help "Path to user's b9-configuration (default: ~/.b9/b9.conf)" <> short 'c' <> long "configuration-file" <>+        metavar "FILENAME")) <*>+  switch (help "Log everything that happens to stdout" <> short 'v' <> long "verbose") <*>+  switch (help "Suppress non-error output" <> short 'q' <> long "quiet") <*>+  optional (strOption (help "Path to a logfile" <> short 'l' <> long "log-file" <> metavar "FILENAME")) <*>+  optional+    (strOption+       (help+          "Root directory for build directories. If not specified '.'. The path will be canonicalized and stored in ${projectRoot}." <>+        short 'b' <>+        long "build-root-dir" <>+        metavar "DIRECTORY")) <*>+  switch (help "Keep build directories after exit" <> short 'k' <> long "keep-build-dir") <*>+  switch (help "Predictable build directory names" <> short 'u' <> long "predictable-build-dir") <*>+  optional+    (strOption+       (help "Cache directory for shared images, default: '~/.b9/repo-cache'" <> long "repo-cache" <>+        metavar "DIRECTORY")) <*>+  optional+    (strOption (help "Remote repository to share image to" <> short 'r' <> long "repo" <> metavar "REPOSITORY_ID")) <*>+  optional+    (strOption+       (help+          ("Override the libvirt-lxc network setting.\nThe special value '" +++           hostNetworkMagicValue ++ "' disables restricted container networking.") <>+        long "network" <>+        metavar "NETWORK_ID"))+  where+    toGlobalOpts ::+         Maybe FilePath+      -> Bool+      -> Bool+      -> Maybe FilePath+      -> Maybe FilePath+      -> Bool+      -> Bool+      -> Maybe FilePath+      -> Maybe String+      -> Maybe String+      -> B9ConfigOverride+    toGlobalOpts cfg verbose quiet logF buildRoot keep predictableBuildDir mRepoCache repo libvirtNet =+      let minLogLevel+            | verbose = Just LogTrace+            | quiet = Just LogError+            | otherwise = Nothing+          b9cfg =+            Endo (verbosity .~ minLogLevel) <> Endo (logFile .~ logF) <> Endo (projectRoot .~ buildRoot) <>+            Endo (keepTempDirs .~ keep) <>+            Endo (uniqueBuildDirs .~ not predictableBuildDir) <>+            Endo (repository .~ repo) <>+            Endo (repositoryCache .~ (Path <$> mRepoCache)) <>+            case libvirtNet of+              Just n+                | n /= hostNetworkMagicValue -> Endo (set (libVirtLXCConfigs . _Just . networkId) (Just n))+              _ -> mempty+       in B9ConfigOverride {_customB9ConfigPath = Path <$> cfg, _customB9Config = b9cfg, _customEnvironment = mempty}  cmds :: Parser (B9ConfigAction ())-cmds = subparser-  (  command-      "version"-      (info (pure runShowVersion) (progDesc "Show program version and exit."))-  <> command+cmds =+  subparser+    (command "version" (info (pure runShowVersion) (progDesc "Show program version and exit.")) <>+     command        "build"-       (info (void . runBuildArtifacts <$> buildFileParser)-             (progDesc "Merge all build file and generate all artifacts.")-       )-  <> command+       (info+          (void . runBuildArtifacts <$> buildFileParser)+          (progDesc "Merge all build file and generate all artifacts.")) <>+     command        "run"        (info-         ((\x y -> void (runRun x y)) <$> sharedImageNameParser <*> many-           (strArgument idm)-         )-         (progDesc-           "Run a command on the lastest version of the specified shared image."-         )-       )-  <> command+          ((\x y -> void (runRun x y)) <$> sharedImageNameParser <*> many (strArgument idm))+          (progDesc "Run a command on the lastest version of the specified shared image.")) <>+     command        "push"        (info-         (runPush <$> sharedImageNameParser)-         (progDesc-           "Push the lastest shared image from cache to the selected  remote repository."-         )-       )-  <> command+          (runPush <$> sharedImageNameParser)+          (progDesc "Push the lastest shared image from cache to the selected  remote repository.")) <>+     command        "pull"        (info-         (runPull <$> optional sharedImageNameParser)-         (progDesc-           "Either pull shared image meta data from all repositories, or only from just a selected one. If additionally the name of a shared images was specified, pull the newest version from either the selected repo, or from the repo with the most recent version."-         )-       )-  <> command+          (runPull <$> optional sharedImageNameParser)+          (progDesc+             "Either pull shared image meta data from all repositories, or only from just a selected one. If additionally the name of a shared images was specified, pull the newest version from either the selected repo, or from the repo with the most recent version.")) <>+     command        "clean-local"-       (info-         (pure runGcLocalRepoCache)-         (progDesc-           "Remove old versions of shared images from the local cache."-         )-       )-  <> command+       (info (pure runGcLocalRepoCache) (progDesc "Remove old versions of shared images from the local cache.")) <>+     command        "clean-remote"        (info-         (pure runGcRemoteRepoCache)-         (progDesc-           "Remove cached meta-data of a remote repository. If no '-r' is given, clean the meta data of ALL remote repositories."-         )-       )-  <> command-       "list"-       (info (pure (void runListSharedImages))-             (progDesc "List shared images.")-       )-  <> command-       "add-repo"-       (info (runAddRepo <$> remoteRepoParser) (progDesc "Add a remote repo.")-       )-  <> command-       "reformat"-       (info (runFormatBuildFiles <$> buildFileParser)-             (progDesc "Re-Format all build files.")-       )-  )+          (pure runGcRemoteRepoCache)+          (progDesc+             "Remove cached meta-data of a remote repository. If no '-r' is given, clean the meta data of ALL remote repositories.")) <>+     command "list" (info (pure (void runListSharedImages)) (progDesc "List shared images.")) <>+     command "add-repo" (info (runAddRepo <$> remoteRepoParser) (progDesc "Add a remote repo.")) <>+     command "reformat" (info (runFormatBuildFiles <$> buildFileParser) (progDesc "Re-Format all build files.")))  buildFileParser :: Parser [FilePath]-buildFileParser = helper <*> some-  (strOption-    (  help-        "Build file to load, specify multiple build files (each witch '-f') to build them all in a single run."-    <> short 'f'-    <> long "project-file"-    <> metavar "FILENAME"-    <> noArgError (ErrorMsg "No build file specified!")-    )-  )+buildFileParser =+  helper <*>+  some+    (strOption+       (help "Build file to load, specify multiple build files (each witch '-f') to build them all in a single run." <>+        short 'f' <>+        long "project-file" <>+        metavar "FILENAME" <>+        noArgError (ErrorMsg "No build file specified!")))  buildVars :: Parser Environment buildVars = flip addPositionalArguments mempty <$> many (strArgument idm)  remoteRepoParser :: Parser RemoteRepo remoteRepoParser =-  helper-    <*> (   RemoteRepo-        <$> strArgument-              (help "The name of the remmote repository." <> metavar "NAME")-        <*> strArgument-              (  help "The (remote) repository root path."-              <> metavar "REMOTE_DIRECTORY"-              )-        <*> (SshPrivKey <$> strArgument-              (  help-                  "Path to the SSH private key file used for  authorization."-              <> metavar "SSH_PRIV_KEY_FILE"-              )-            )-        <*> (   SshRemoteHost-            <$> (   (,)-                <$> strArgument-                      (help "Repo hostname or IP" <> metavar "HOST")-                <*> argument-                      auto-                      (  help "SSH-Port number"-                      <> value 22-                      <> showDefault-                      <> metavar "PORT"-                      )-                )-            )-        <*> (   SshRemoteUser-            <$> strArgument (help "SSH-User to login" <> metavar "USER")-            )-        )+  helper <*>+  (RemoteRepo <$> strArgument (help "The name of the remmote repository." <> metavar "NAME") <*>+   strArgument (help "The (remote) repository root path." <> metavar "REMOTE_DIRECTORY") <*>+   (SshPrivKey <$>+    strArgument (help "Path to the SSH private key file used for  authorization." <> metavar "SSH_PRIV_KEY_FILE")) <*>+   (SshRemoteHost <$>+    ((,) <$> strArgument (help "Repo hostname or IP" <> metavar "HOST") <*>+     argument auto (help "SSH-Port number" <> value 22 <> showDefault <> metavar "PORT"))) <*>+   (SshRemoteUser <$> strArgument (help "SSH-User to login" <> metavar "USER")))  sharedImageNameParser :: Parser SharedImageName-sharedImageNameParser =-  helper-    <*> (   SharedImageName-        <$> strArgument (help "Shared image name" <> metavar "NAME")-        )+sharedImageNameParser = helper <*> (SharedImageName <$> strArgument (help "Shared image name" <> metavar "NAME"))

@@ -1,8 +1,10 @@-{-| B9 is a library and build tool with primitive operations to rmrun a-    build script inside a virtual machine and to create and convert-    virtual machine image files as well as related ISO and VFAT disk images-    for e.g. cloud-init configuration sources.+{-| B9 is a library and build tool with which one can create/convert different types+    of VM images. Additionally installation steps - like installing software -+    can be done in a LXC container, running on the disk images. +    B9 allows to create and convert virtual machine image files as well as+    related ISO and VFAT disk images for e.g. cloud-init configuration sources.+     This module re-exports the modules needed to build a tool around the     library, e.g. see @src\/cli\/Main.hs@ as an example. @@ -228,6 +230,7 @@   (runB9     (do       MkSelectedRemoteRepo remoteRepo <- getSelectedRemoteRepo+       let repoPred = maybe (== Cache) ((==) . toRemoteRepository) remoteRepo       allRepos <- getRemoteRepos       if isNothing remoteRepo

@@ -35,7 +35,6 @@   , modifyPermanentConfig   , customB9Config   , customB9ConfigPath-  , customLibVirtNetwork   , customEnvironment   , overrideB9ConfigPath   , overrideB9Config@@ -55,62 +54,43 @@   , ExecEnvType(..)   , Environment   , module X-  )-where+  ) where -import           B9.B9Config.LibVirtLXC        as X-import           B9.B9Config.Repository        as X-import           Control.Eff-import           Control.Eff.Reader.Lazy-import           Control.Eff.Writer.Lazy-import           Control.Exception-import           Control.Lens                  as Lens-                                                ( (&)-                                                , (.~)-                                                , (?~)-                                                , (^.)-                                                , _Just-                                                , makeLenses-                                                , over-                                                , set-                                                )-import           Control.Monad                  ( (>=>)-                                                , filterM-                                                )-import           Control.Monad.IO.Class-import           Data.ConfigFile.B9Extras       ( CPDocument-                                                , CPError-                                                , CPGet-                                                , CPOptionSpec-                                                , CPReadException(..)-                                                , addSectionCP-                                                , emptyCP-                                                , mergeCP-                                                , readCP-                                                , readCPDocument-                                                , setShowCP-                                                , toStringCP-                                                )-import           Data.Function                  ( on )-import           Data.List                      ( inits )-import           Data.Maybe                     ( fromMaybe-                                                , listToMaybe-                                                , maybeToList-                                                )-import           Data.Monoid-import           Data.Semigroup                as Semigroup-                                         hiding ( Last(..) )-import           Data.Version-import           System.Directory-import           System.FilePath                ( (<.>) )-import           System.IO.B9Extras             ( SystemPath(..)-                                                , ensureDir-                                                , resolve-                                                )-import           Text.Printf                    ( printf )-import           B9.Environment-import           Text.ParserCombinators.ReadP-import qualified Paths_b9                      as My+import B9.B9Config.LibVirtLXC as X+import B9.B9Config.Repository as X+import B9.Environment+import Control.Eff+import Control.Eff.Reader.Lazy+import Control.Eff.Writer.Lazy+import Control.Exception+import Control.Lens as Lens ((?~), (^.), makeLenses, set, (<>~))+import Control.Monad ((>=>), filterM)+import Control.Monad.IO.Class+import Data.ConfigFile.B9Extras+  ( CPDocument+  , CPError+  , CPGet+  , CPOptionSpec+  , CPReadException(..)+  , addSectionCP+  , emptyCP+  , mergeCP+  , readCP+  , readCPDocument+  , setShowCP+  , toStringCP+  )+import Data.Function (on)+import Data.List (inits)+import Data.Maybe (fromMaybe, listToMaybe, maybeToList)+import Data.Monoid+import Data.Semigroup as Semigroup hiding (Last(..))+import Data.Version+import qualified Paths_b9 as My+import System.Directory+import System.FilePath ((<.>))+import System.IO.B9Extras (SystemPath(..), ensureDir, resolve)+import Text.Printf (printf)  data ExecEnvType =   LibVirtLXC@@ -140,37 +120,25 @@   } deriving (Show, Eq)  instance Semigroup B9Config where-  c <> c' = B9Config-    { _verbosity = getLast $ on mappend (Last . _verbosity) c c'-    , _logFile = getLast $ on mappend (Last . _logFile) c c'-    , _projectRoot = getLast $ on mappend (Last . _projectRoot) c c'-    , _keepTempDirs = getAny $ on mappend (Any . _keepTempDirs) c c'-    , _execEnvType = LibVirtLXC-    , _uniqueBuildDirs = getAll ((mappend `on` (All . _uniqueBuildDirs)) c c')-    , _repositoryCache = getLast $ on mappend (Last . _repositoryCache) c c'-    , _repository = getLast ((mappend `on` (Last . _repository)) c c')-    , _interactive = getAny ((mappend `on` (Any . _interactive)) c c')-    , _maxLocalSharedImageRevisions =-      getLast ((mappend `on` (Last . _maxLocalSharedImageRevisions)) c c')-    , _libVirtLXCConfigs = getLast-                             ((mappend `on` (Last . _libVirtLXCConfigs)) c c')-    , _remoteRepos = (mappend `on` _remoteRepos) c c'-    }+  c <> c' =+    B9Config+      { _verbosity = getLast $ on mappend (Last . _verbosity) c c'+      , _logFile = getLast $ on mappend (Last . _logFile) c c'+      , _projectRoot = getLast $ on mappend (Last . _projectRoot) c c'+      , _keepTempDirs = getAny $ on mappend (Any . _keepTempDirs) c c'+      , _execEnvType = LibVirtLXC+      , _uniqueBuildDirs = getAll ((mappend `on` (All . _uniqueBuildDirs)) c c')+      , _repositoryCache = getLast $ on mappend (Last . _repositoryCache) c c'+      , _repository = getLast ((mappend `on` (Last . _repository)) c c')+      , _interactive = getAny ((mappend `on` (Any . _interactive)) c c')+      , _maxLocalSharedImageRevisions = getLast ((mappend `on` (Last . _maxLocalSharedImageRevisions)) c c')+      , _libVirtLXCConfigs = getLast ((mappend `on` (Last . _libVirtLXCConfigs)) c c')+      , _remoteRepos = (mappend `on` _remoteRepos) c c'+      }  instance Monoid B9Config where   mappend = (<>)-  mempty  = B9Config Nothing-                     Nothing-                     Nothing-                     False-                     LibVirtLXC-                     True-                     Nothing-                     Nothing-                     False-                     Nothing-                     Nothing-                     []+  mempty = B9Config Nothing Nothing Nothing False LibVirtLXC True Nothing Nothing False Nothing Nothing []  -- | Reader for 'B9Config'. See 'getB9Config' and 'localB9Config'. --@@ -194,8 +162,7 @@ -- | Run an action with an updated runtime configuration. -- -- @since 0.5.65-localB9Config-  :: Member B9ConfigReader e => (B9Config -> B9Config) -> Eff e a -> Eff e a+localB9Config :: Member B9ConfigReader e => (B9Config -> B9Config) -> Eff e a -> Eff e a localB9Config = local  -- | An alias for 'getB9Config'.@@ -241,15 +208,22 @@ -- This is useful, i.e. when dealing with command line parameters. data B9ConfigOverride = B9ConfigOverride   { _customB9ConfigPath :: Maybe SystemPath-  , _customB9Config :: B9Config-  , _customLibVirtNetwork :: Maybe (Maybe String)+  , _customB9Config :: Endo B9Config   , _customEnvironment :: Environment-  } deriving (Show)+  } +instance Show B9ConfigOverride where+  show x =+    unlines+      [ "config file path:    " ++ show (_customB9ConfigPath x)+      , "config modification: " ++ show (appEndo (_customB9Config x) mempty)+      , "environment:         " ++ show (_customEnvironment x)+      ]+ -- | An empty default 'B9ConfigOverride' value, that will neither apply any -- additional 'B9Config' nor change the path of the configuration file. noB9ConfigOverride :: B9ConfigOverride-noB9ConfigOverride = B9ConfigOverride Nothing mempty mempty mempty+noB9ConfigOverride = B9ConfigOverride Nothing mempty mempty  makeLenses ''B9Config @@ -260,13 +234,12 @@ overrideB9ConfigPath p = customB9ConfigPath ?~ p  -- | Modify the runtime configuration.-overrideB9Config-  :: (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride-overrideB9Config = over customB9Config+overrideB9Config :: (B9Config -> B9Config) -> B9ConfigOverride -> B9ConfigOverride+overrideB9Config e = customB9Config <>~ Endo e  -- | Define the current working directory to be used when building. overrideWorkingDirectory :: FilePath -> B9ConfigOverride -> B9ConfigOverride-overrideWorkingDirectory p = customB9Config . projectRoot ?~ p+overrideWorkingDirectory p = overrideB9Config (projectRoot ?~ p)  -- | Overwrite the 'verbosity' settings in the configuration with those given. overrideVerbosity :: LogLevel -> B9ConfigOverride -> B9ConfigOverride@@ -283,8 +256,7 @@ -- 'B9ConfigReader' and 'IO'. -- -- @since 0.5.65-type B9ConfigAction a-  = Eff '[B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO] a+type B9ConfigAction a = Eff '[ B9ConfigWriter, B9ConfigReader, EnvironmentReader, Lift IO] a  -- | Accumulate 'B9Config' changes that go back to the config file. See -- 'B9ConfigAction' and 'modifyPermanentConfig'.@@ -313,67 +285,34 @@ runB9ConfigActionWithOverrides :: B9ConfigAction a -> B9ConfigOverride -> IO a runB9ConfigActionWithOverrides act cfg = do   configuredCfgPath <- traverse resolve (cfg ^. customB9ConfigPath)-  fallbackCfgPath   <- resolve defaultB9ConfigFile-  let-    cfgPathCandidates = case My.version of-      Version v _ ->-        (concatMap-            (\c ->-              (\v' -> c <.> showVersion (makeVersion v')) <$> reverse (inits v)-            )-            (maybeToList configuredCfgPath)-          )--          ++ (   (\v' -> fallbackCfgPath <.> showVersion (makeVersion v'))-             <$> reverse (inits v)-             )-    pathToCreate = fromMaybe fallbackCfgPath configuredCfgPath-  existingCfgPaths <- filterM-    (\candidate -> putStrLn ("Trying to load config file: " ++ candidate)-      >> doesFileExist candidate-    )-    cfgPathCandidates+  fallbackCfgPath <- resolve defaultB9ConfigFile+  let cfgPathCandidates =+        case My.version of+          Version v _ ->+            concatMap+              (\c -> (\v' -> c <.> showVersion (makeVersion v')) <$> reverse (inits v))+              (maybeToList configuredCfgPath) +++            ((\v' -> fallbackCfgPath <.> showVersion (makeVersion v')) <$> reverse (inits v))+      pathToCreate = fromMaybe fallbackCfgPath configuredCfgPath+  existingCfgPaths <- filterM doesFileExist cfgPathCandidates   let cfgPath = fromMaybe pathToCreate (listToMaybe existingCfgPaths)   cp <- openOrCreateB9Config cfgPath   case parseB9Config cp of-    Left e -> fail-      (printf "Internal configuration load error, please report this: %s\n"-              (show e)-      )+    Left e -> fail (printf "Internal configuration load error, please report this: %s\n" (show e))     Right permanentConfigIn -> do-      let runtimeCfg =-            let rc = permanentConfigIn <> (cfg ^. customB9Config)-            in  case cfg ^. customLibVirtNetwork of-                  Just overridenNetwork ->-                    rc-                      &  libVirtLXCConfigs-                      .  _Just-                      .  networkId-                      .~ overridenNetwork-                  Nothing -> rc-      (res, permanentB9ConfigUpdates) <- runLift-        (runEnvironmentReader (cfg ^. customEnvironment)-                              (runReader runtimeCfg (runMonoidWriter act))-        )+      let runtimeCfg = appEndo (cfg ^. customB9Config) permanentConfigIn+      (res, permanentB9ConfigUpdates) <-+        runLift (runEnvironmentReader (cfg ^. customEnvironment) (runReader runtimeCfg (runMonoidWriter act)))       let cpExtErr = modifyCPDocument cp <$> permanentB9ConfigUpdateMaybe           permanentB9ConfigUpdateMaybe =-            if appEndo permanentB9ConfigUpdates permanentConfigIn-               == permanentConfigIn-            then-              Nothing-            else-              Just permanentB9ConfigUpdates-      cpExt <- maybe-        (return Nothing)-        (either-          ( fail-          . printf-              "Internal configuration update error! Please report this: %s\n"-          . show-          )-          (return . Just)-        )-        cpExtErr+            if appEndo permanentB9ConfigUpdates permanentConfigIn == permanentConfigIn+              then Nothing+              else Just permanentB9ConfigUpdates+      cpExt <-+        maybe+          (return Nothing)+          (either (fail . printf "Internal configuration update error! Please report this: %s\n" . show) (return . Just))+          cpExtErr       mapM_ (writeB9CPDocument (cfg ^. customB9ConfigPath)) cpExt       return res @@ -394,11 +333,10 @@     exists <- doesFileExist cfgFile     if exists       then readCPDocument (Path cfgFile)-      else-        let res = b9ConfigToCPDocument defaultB9Config-        in  case res of-              Left  e  -> throwIO (CPReadException cfgFile e)-              Right cp -> writeFile cfgFile (toStringCP cp) >> return cp+      else let res = b9ConfigToCPDocument defaultB9Config+            in case res of+                 Left e -> throwIO (CPReadException cfgFile e)+                 Right cp -> writeFile cfgFile (toStringCP cp) >> return cp  -- | Write the configuration in the 'CPDocument' to either the user supplied -- configuration file path or to 'defaultB9ConfigFile'.@@ -410,19 +348,21 @@   liftIO (writeFile cfgFile (toStringCP cp))  defaultB9Config :: B9Config-defaultB9Config = B9Config { _verbosity                    = Just LogInfo-                           , _logFile                      = Nothing-                           , _projectRoot                  = Nothing-                           , _keepTempDirs                 = False-                           , _execEnvType                  = LibVirtLXC-                           , _uniqueBuildDirs              = True-                           , _repository                   = Nothing-                           , _repositoryCache = Just defaultRepositoryCache-                           , _interactive                  = False-                           , _maxLocalSharedImageRevisions = Just 2-                           , _libVirtLXCConfigs = Just defaultLibVirtLXCConfig-                           , _remoteRepos                  = []-                           }+defaultB9Config =+  B9Config+    { _verbosity = Just LogInfo+    , _logFile = Nothing+    , _projectRoot = Nothing+    , _keepTempDirs = False+    , _execEnvType = LibVirtLXC+    , _uniqueBuildDirs = True+    , _repository = Nothing+    , _repositoryCache = Just defaultRepositoryCache+    , _interactive = False+    , _maxLocalSharedImageRevisions = Just 2+    , _libVirtLXCConfigs = Just defaultLibVirtLXCConfig+    , _remoteRepos = []+    }  defaultRepositoryCache :: SystemPath defaultRepositoryCache = InB9UserDir "repo-cache"@@ -477,15 +417,9 @@   cp5 <- setShowCP cp4 cfgFileSection keepTempDirsK (_keepTempDirs c)   cp6 <- setShowCP cp5 cfgFileSection execEnvTypeK (_execEnvType c)   cp7 <- setShowCP cp6 cfgFileSection uniqueBuildDirsK (_uniqueBuildDirs c)-  cp8 <- setShowCP cp7-                   cfgFileSection-                   maxLocalSharedImageRevisionsK-                   (_maxLocalSharedImageRevisions c)+  cp8 <- setShowCP cp7 cfgFileSection maxLocalSharedImageRevisionsK (_maxLocalSharedImageRevisions c)   cp9 <- setShowCP cp8 cfgFileSection repositoryCacheK (_repositoryCache c)-  cpA <- foldr (>=>)-               return-               (libVirtLXCConfigToCPDocument <$> _libVirtLXCConfigs c)-               cp9+  cpA <- foldr (>=>) return (libVirtLXCConfigToCPDocument <$> _libVirtLXCConfigs c) cp9   cpFinal <- foldr (>=>) return (remoteRepoToCPDocument <$> _remoteRepos c) cpA   setShowCP cpFinal cfgFileSection repositoryK (_repository c) @@ -494,20 +428,13 @@  parseB9Config :: CPDocument -> Either CPError B9Config parseB9Config cp =-  let-    getr :: (CPGet a) => CPOptionSpec -> Either CPError a-    getr = readCP cp cfgFileSection-  in-    B9Config-    <$> getr verbosityK-    <*> getr logFileK-    <*> getr projectRootK-    <*> getr keepTempDirsK-    <*> getr execEnvTypeK-    <*> getr uniqueBuildDirsK-    <*> getr repositoryCacheK-    <*> getr repositoryK-    <*> pure False-    <*> pure (either (const Nothing) id (getr maxLocalSharedImageRevisionsK))-    <*> pure (either (const Nothing) Just (parseLibVirtLXCConfig cp))-    <*> parseRemoteRepos cp+  let getr :: (CPGet a) => CPOptionSpec -> Either CPError a+      getr = readCP cp cfgFileSection+   in B9Config <$> getr verbosityK <*> getr logFileK <*> getr projectRootK <*> getr keepTempDirsK <*> getr execEnvTypeK <*>+      getr uniqueBuildDirsK <*>+      getr repositoryCacheK <*>+      getr repositoryK <*>+      pure False <*>+      pure (either (const Nothing) id (getr maxLocalSharedImageRevisionsK)) <*>+      pure (either (const Nothing) Just (parseLibVirtLXCConfig cp)) <*>+      parseRemoteRepos cp

@@ -113,7 +113,7 @@       traceL (printf "Project Root Directory: %s" rootD)       buildD <- getBuildDir       traceL (printf "Build Directory:        %s" buildD)-      r       <- action+      r       <-  addLocalStringBinding ("buildDirRoot", buildD) action       tsAfter <- liftIO getCurrentTime       let duration = show (tsAfter `diffUTCTime` startTime)       infoL (printf "DURATION: %s" duration)

@@ -34,6 +34,7 @@ import           Control.Eff.Reader.Lazy       as Eff import           Control.Parallel.Strategies import           Data.Data+import           Data.Foldable import           Data.HashMap.Strict            ( HashMap ) import qualified Data.HashMap.Strict           as HashMap import           Data.Maybe                     ( maybe@@ -54,9 +55,9 @@ instance Semigroup Environment where   e1 <> e2 = MkEnvironment     { nextPosition    = case (nextPosition e1, nextPosition e2) of-                          (0 , 0 ) -> 0-                          (0 , p2) -> p2-                          (p1, 0 ) -> p1+                          (1 , 1 ) -> 1+                          (1 , p2) -> p2+                          (p1, 1 ) -> p1                           _        -> error                             (  "Overlapping positional arguments (<>): ("                             ++ show e1@@ -86,7 +87,7 @@     }  instance Monoid Environment where-  mempty = MkEnvironment 0 HashMap.empty+  mempty = MkEnvironment 1 HashMap.empty  -- | If environment variables @arg_1 .. arg_n@ are bound -- and a list of @k@ additional values are passed to this function,@@ -97,8 +98,8 @@ -- @since 0.5.62 addPositionalArguments :: [Text] -> Environment -> Environment addPositionalArguments = flip-  (foldr-    (\arg (MkEnvironment i e) -> MkEnvironment+  (foldl'+    (\(MkEnvironment i e) arg -> MkEnvironment       (i + 1)       (HashMap.insert (unsafeRenderToText ("arg_" ++ show i)) arg e)     )@@ -217,7 +218,7 @@   { duplicateKey         :: Text   , duplicateKeyOldValue :: Text   , duplicateKeyNewValue :: Text-  } deriving (Typeable, Show)+  } deriving (Typeable, Show, Eq)  instance Exception DuplicateKey @@ -227,7 +228,7 @@ data KeyNotFound =   MkKeyNotFound Text                 Environment-  deriving (Typeable)+  deriving (Typeable, Eq)  instance Exception KeyNotFound 

@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+module B9.EnvironmentSpec (spec) where++import Test.Hspec+import Data.Text+import B9.Environment+import Control.Eff++spec :: Spec+spec =+  describe "Environment" $+  describe "addLocalPositionalArguments" $ do+     let k = 13 :: Integer+         j = 7 :: Integer+         n = 13 :: Integer+         args = [pack (show i) | i <- [1 .. n]]++         k_key = pack ("arg_" ++ show k)+         j_key = pack ("arg_" ++ show j)++         k_value = pack (show k)+         j_value = pack (show j)++         testEnv = addPositionalArguments args mempty+         inEnv = run . runEnvironmentReader testEnv++     it "generates keys prefixed with arg_ followed by an ascending numeric index, starting with 1" $+         let res = inEnv $ do+                     ej_value <- lookupEither j_key+                     ek_value <- lookupEither k_key+                     e_arg_0 <- lookupEither "arg_0"+                     return (ej_value, ek_value, e_arg_0)+         in res `shouldBe` (Right j_value, Right k_value, Left (MkKeyNotFound "arg_0" testEnv))++--                      run . runEnvironmentReader testEnv $ do+

@@ -6,5 +6,5 @@ - template-0.2.0.10 - extensible-effects-5.0.0.1 -resolver: lts-13.9+resolver: lts-13.13 require-stack-version: ">=1.6.5"