b9 0.5.46 → 0.5.47

raw patch · 5 files changed

+84/−31 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• b9.cabal +1/−1
• src/cli/Main.hs +11/−1
• src/lib/B9/ArtifactGenerator.hs +19/−20
• src/lib/B9/B9Config.hs +16/−8
• src/lib/B9/B9Monad.hs +37/−1

@@ -1,5 +1,5 @@ name:                b9-version:             0.5.46+version:             0.5.47  synopsis:            A tool and library for building virtual machine images. 

@@ -78,6 +78,13 @@                 )         <*> optional                 ( strOption+                    (  help "Output file for a command/timing profile"+                    <> long "profile-file"+                    <> metavar "FILENAME"+                    )+                )+        <*> optional+                ( strOption                     (  help                           "Root directory for build directories. If not specified '.'. The path will be canonicalized and stored in ${buildDirRoot}."                     <> short 'b'@@ -116,12 +123,13 @@         -> Bool         -> Maybe FilePath         -> Maybe FilePath+        -> Maybe FilePath         -> Bool         -> Bool         -> Maybe FilePath         -> Maybe String         -> B9ConfigOverride-    toGlobalOpts cfg verbose quiet logF buildRoot keep notUnique mRepoCache repo+    toGlobalOpts cfg verbose quiet logF profF buildRoot keep notUnique mRepoCache repo         = let minLogLevel = if verbose                   then Just LogTrace                   else if quiet then Just LogError else Nothing@@ -131,6 +139,8 @@                       .~ minLogLevel                       &  logFile                       .~ logF+                      &  profileFile+                      .~ profF                       &  buildDirRoot                       .~ buildRoot                       &  keepTempDirs

@@ -179,7 +179,7 @@ getArtifactSourceFiles (FromContent   f _) = [f] getArtifactSourceFiles (FromFile      f _) = [f] getArtifactSourceFiles (IntoDirectory pd as) =-    (pd </>) <$> (as >>= getArtifactSourceFiles)+    (pd</>) <$> (as >>= getArtifactSourceFiles) getArtifactSourceFiles (FromDirectory _ as) = as >>= getArtifactSourceFiles getArtifactSourceFiles (SetPermissions _ _ _ as) =     as >>= getArtifactSourceFiles@@ -275,11 +275,11 @@ getAssemblyOutput (VmImages ts _) =     AssemblyGeneratesOutputFiles . getImageDestinationOutputFiles <$> ts getAssemblyOutput (CloudInit ts o) = getCloudInitOutputFiles o <$> ts-  where-    getCloudInitOutputFiles baseName t = case t of-        CI_ISO  -> AssemblyGeneratesOutputFiles [baseName <.> "iso"]-        CI_VFAT -> AssemblyGeneratesOutputFiles [baseName <.> "vfat"]-        CI_DIR  -> AssemblyCopiesSourcesToDirectory baseName+ where+  getCloudInitOutputFiles baseName t = case t of+      CI_ISO  -> AssemblyGeneratesOutputFiles [baseName <.> "iso"]+      CI_VFAT -> AssemblyGeneratesOutputFiles [baseName <.> "vfat"]+      CI_DIR  -> AssemblyCopiesSourcesToDirectory baseName   -- * QuickCheck instances@@ -297,21 +297,21 @@  arbitraryEachT :: Gen ([ArtifactGenerator] -> ArtifactGenerator) arbitraryEachT =-    sized-        $ \n ->-              EachT-                  <$> vectorOf n (halfSize (listOf1 (choose ('a', 'z'))))-                  <*> oneof-                          [ listOf (vectorOf n (halfSize arbitrary))-                          , listOf1 (listOf (halfSize arbitrary))-                          ]+    sized $+    \n ->+         EachT <$> vectorOf n (halfSize (listOf1 (choose ('a', 'z')))) <*>+         oneof+             [ listOf (vectorOf n (halfSize arbitrary))+             , listOf1 (listOf (halfSize arbitrary))]  arbitraryEach :: Gen ([ArtifactGenerator] -> ArtifactGenerator)-arbitraryEach = sized $ \n -> Each <$> listOf-    ( (,) <$> listOf1 (choose ('a', 'z')) <*> vectorOf-        n-        (halfSize (listOf1 (choose ('a', 'z'))))-    )+arbitraryEach =+    sized $+    \n ->+         Each <$>+         listOf+             ((,) <$> listOf1 (choose ('a', 'z')) <*>+              vectorOf n (halfSize (listOf1 (choose ('a', 'z')))))   instance Arbitrary ArtifactSource where@@ -336,4 +336,3 @@  instance Arbitrary CloudInitType where     arbitrary = elements [CI_ISO, CI_VFAT, CI_DIR]-

@@ -8,6 +8,7 @@                    , buildDirRoot                    , keepTempDirs                    , execEnvType+                   , profileFile                    , envVars                    , uniqueBuildDirs                    , repositoryCache@@ -80,6 +81,7 @@                          , _buildDirRoot :: Maybe FilePath                          , _keepTempDirs :: Bool                          , _execEnvType :: ExecEnvType+                         , _profileFile :: Maybe FilePath                          , _envVars :: BuildVariables                          , _uniqueBuildDirs :: Bool                          , _repositoryCache :: Maybe SystemPath@@ -97,6 +99,7 @@       , _buildDirRoot = getLast $ on mappend (Last . _buildDirRoot) c c'       , _keepTempDirs = getAny $ on mappend (Any . _keepTempDirs) c c'       , _execEnvType = LibVirtLXC+      , _profileFile = getLast $ on mappend (Last . _profileFile) c c'       , _envVars = on mappend _envVars c c'       , _uniqueBuildDirs = getAll ((mappend `on` (All . _uniqueBuildDirs)) c c')       , _repositoryCache = getLast $ on mappend (Last . _repositoryCache) c c'@@ -109,7 +112,7 @@  instance Monoid B9Config where   mappend = (Sem.<>)-  mempty = B9Config Nothing Nothing Nothing False LibVirtLXC [] True+  mempty = B9Config Nothing Nothing Nothing False LibVirtLXC Nothing [] True                     Nothing Nothing False Nothing Nothing []  -- | Override b9 configuration items and/or the path of the b9 configuration file.@@ -261,6 +264,7 @@   , _buildDirRoot                 = Nothing   , _keepTempDirs                 = False   , _execEnvType                  = LibVirtLXC+  , _profileFile                  = Nothing   , _envVars                      = []   , _uniqueBuildDirs              = True   , _repository                   = Nothing@@ -285,6 +289,8 @@ keepTempDirsK = "keep_temp_dirs" execEnvTypeK :: String execEnvTypeK = "exec_env"+profileFileK :: String+profileFileK = "profile_file" envVarsK :: String envVarsK = "environment_vars" uniqueBuildDirsK :: String@@ -314,21 +320,22 @@   cp4 <- setShowCP cp3 cfgFileSection buildDirRootK (_buildDirRoot c)   cp5 <- setShowCP cp4 cfgFileSection keepTempDirsK (_keepTempDirs c)   cp6 <- setShowCP cp5 cfgFileSection execEnvTypeK (_execEnvType c)-  cp7 <- setShowCP cp6 cfgFileSection envVarsK (_envVars c)-  cp8 <- setShowCP cp7 cfgFileSection uniqueBuildDirsK (_uniqueBuildDirs c)-  cp9 <- setShowCP cp8+  cp7 <- setShowCP cp6 cfgFileSection profileFileK (_profileFile c)+  cp8 <- setShowCP cp7 cfgFileSection envVarsK (_envVars c)+  cp9 <- setShowCP cp8 cfgFileSection uniqueBuildDirsK (_uniqueBuildDirs c)+  cpA <- setShowCP cp9                    cfgFileSection                    maxLocalSharedImageRevisionsK                    (_maxLocalSharedImageRevisions c)-  cpA <- setShowCP cp9 cfgFileSection repositoryCacheK (_repositoryCache c)-  cpB <-+  cpB <- setShowCP cpA cfgFileSection repositoryCacheK (_repositoryCache c)+  cpC <-     ( foldr (>=>)             return             (libVirtLXCConfigToCPDocument <$> (_libVirtLXCConfigs c))       )-      cpA+      cpB   cpFinal <- (foldr (>=>) return (remoteRepoToCPDocument <$> _remoteRepos c))-    cpB+    cpC   setShowCP cpFinal cfgFileSection repositoryK (_repository c)  readB9Config :: MonadIO m => Maybe SystemPath -> m CPDocument@@ -346,6 +353,7 @@         <*> getr buildDirRootK         <*> getr keepTempDirsK         <*> getr execEnvTypeK+        <*> getr profileFileK         <*> getr envVarsK         <*> getr uniqueBuildDirsK         <*> getr repositoryCacheK

@@ -45,9 +45,17 @@              ,bsLogFileHandle :: Maybe SysIO.Handle              ,bsSelectedRemoteRepo :: Maybe RemoteRepo              ,bsRepoCache :: RepoCache+             ,bsProf :: [ProfilingEntry]              ,bsStartTime :: UTCTime              ,bsInheritStdIn :: Bool} +data ProfilingEntry+  = IoActionDuration NominalDiffTime+  | LogEvent LogLevel+             String+  deriving (Eq,Show)++ run :: MonadIO m => B9 a -> B9ConfigAction m a run action = do   cfg <- askRuntimeConfig@@ -92,6 +100,7 @@                        logFileHandle                        selectedRemoteRepo                        repoCache+                       []                        now                        (_interactive finalCfg)       selectedRemoteRepo = do@@ -103,6 +112,10 @@             (show remoteRepos')           )     (r, ctxOut) <- runStateT (runB9 wrappedAction) ctx+    -- Write a profiling report+    when (isJust (_profileFile cfg)) $ writeFile+      (fromJust (_profileFile cfg))+      (unlines $ show <$> reverse (bsProf ctxOut))     return r   createBuildDir cfg buildId = if _uniqueBuildDirs cfg     then do@@ -159,6 +172,22 @@ getRepoCache :: B9 RepoCache getRepoCache = gets bsRepoCache +-- getDownloader :: B9 Downloader+-- getDownloader = gets bsDownloader+--+-- -- | Configuration for a tool that retreives arbitrary URL and returns them to+-- -- @stdout@.+-- data Downloader =+--   Downloader {downloaderCmd :: FilePath+--              ,downloaderArgsBeforeUrl :: [String]+--              ,downloaderUrlArgPrintfFormatString :: [String]+--              ,downloaderArgsAfterUrl :: [String]}+--   deriving (Read,Show,Eq,Ord,Typeable,Generic)+--+-- readContentFromUrl :: String -> B9 B.ByteString+-- readContentFromUrl url = do+--   return expression+ cmd :: String -> B9 () cmd str = do   inheritStdIn <- gets bsInheritStdIn@@ -217,6 +246,7 @@ b9Log level msg = do   lv  <- gets $ _verbosity . bsCfg   lfh <- gets bsLogFileHandle+  modify $ \ctx -> ctx { bsProf = LogEvent level msg : bsProf ctx }   B9 $ liftIO $ logImpl lv lfh level msg  logImpl :: Maybe LogLevel -> Maybe SysIO.Handle -> LogLevel -> String -> IO ()@@ -246,4 +276,10 @@   deriving (Functor,Applicative,Monad,MonadState BuildState)  instance MonadIO B9 where-  liftIO m = B9 $ liftIO m+  liftIO m =+    do start <- B9 $ liftIO getCurrentTime+       res <- B9 $ liftIO m+       stop <- B9 $ liftIO getCurrentTime+       let durMS = IoActionDuration (stop `diffUTCTime` start)+       modify $ \ctx -> ctx {bsProf = durMS : bsProf ctx}+       return res