b9 0.5.42 → 0.5.43

raw patch · 9 files changed

+197/−182 lines, 9 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 +30/−15
• src/lib/B9.hs +32/−62
• src/lib/B9/B9Monad.hs +16/−9
• src/lib/B9/Builder.hs +5/−4
• src/lib/B9/Invokation.hs +66/−29
• src/lib/B9/Shake/Actions.hs +7/−5
• src/lib/B9/Shake/SharedImageRules.hs +38/−56
• stack-lts-9.4.yaml +2/−1

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

@@ -1,17 +1,32 @@-module Main where+module Main(main) where  import Options.Applicative             hiding (action) import Options.Applicative.Help.Pretty hiding ((</>)) import B9-import Control.Lens ((.~), (&))+import Control.Lens ((.~), (&), over, (^.))  main :: IO () main = do     b9Opts <- parseCommandLine-    (_, result) <- runB9 b9Opts-    exit result+    result <- invokeB9 (applyB9RunParameters b9Opts)+    exit (maybe False (const True) result)     where exit success = when (not success) (exitWith (ExitFailure 128)) +-- | A data structure that contains the `B9Invokation`+-- as well as build parameters.+data B9RunParameters a =+  B9RunParameters+            B9ConfigOverride+            (B9Invokation a ())+            BuildVariables++applyB9RunParameters :: B9RunParameters a -> B9Invokation a ()+applyB9RunParameters (B9RunParameters overrides action vars) = do+    modifyInvokationConfig+      (over envVars (++ vars) . const (overrides ^. customB9Config))+    mapM_ overrideB9ConfigPath (overrides ^. customB9ConfigPath)+    action+ parseCommandLine :: IO (B9RunParameters ()) parseCommandLine = execParser     ( info@@ -124,23 +139,23 @@                   , _customB9Config = b9cfg                   } -cmds :: Parser (B9Invokation ())+cmds :: Parser (B9Invokation () ()) cmds = subparser     (  command           "version"-          ( info (pure runShowVersion)+          ( info (pure (ignoreActionResults runShowVersion))                  (progDesc "Show program version and exit.")           )     <> command            "build"            ( info-               (runBuildArtifacts <$> buildFileParser)+               (ignoreActionResults . runBuildArtifacts <$> buildFileParser)                (progDesc "Merge all build file and generate all artifacts.")            )     <> command            "run"            ( info-               (runRun <$> sharedImageNameParser <*> many (strArgument idm))+               (ignoreActionResults <$> (runRun <$> sharedImageNameParser <*> many (strArgument idm)))                ( progDesc                    "Run a command on the lastest version of the specified shared image. All modifications are lost on exit."                )@@ -148,7 +163,7 @@     <> command            "push"            ( info-               (runPush <$> sharedImageNameParser)+               (ignoreActionResults . runPush <$> sharedImageNameParser)                ( progDesc                    "Push the lastest shared image from cache to the selected  remote repository."                )@@ -156,7 +171,7 @@     <> command            "pull"            ( info-               (runPull <$> optional sharedImageNameParser)+               (ignoreActionResults . 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."                )@@ -164,7 +179,7 @@     <> command            "clean-local"            ( info-               (pure runGcLocalRepoCache)+               (pure (ignoreActionResults runGcLocalRepoCache))                ( progDesc                    "Remove old versions of shared images from the local cache."                )@@ -172,22 +187,22 @@     <> command            "clean-remote"            ( info-               (pure runGcRemoteRepoCache)+               (pure (ignoreActionResults 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 runListSharedImages) (progDesc "List shared images."))+           (info (pure (ignoreActionResults runListSharedImages)) (progDesc "List shared images."))     <> command            "add-repo"-           ( info (runAddRepo <$> remoteRepoParser)+           ( info (ignoreActionResults . runAddRepo <$> remoteRepoParser)                   (progDesc "Add a remote repo.")            )     <> command            "reformat"-           ( info (runFormatBuildFiles <$> buildFileParser)+           ( info (ignoreActionResults . runFormatBuildFiles <$> buildFileParser)                   (progDesc "Re-Format all build files.")            )     )

@@ -12,9 +12,6 @@ -}  module B9 ( b9Version, b9VersionString-          , B9RunParameters(..)-          , runB9-          , defaultB9RunParameters           , runShowVersion           , runBuildArtifacts           , runFormatBuildFiles@@ -34,7 +31,6 @@ import System.IO.Error (isDoesNotExistError) import System.Directory (removeFile) import Data.Monoid as X-import Data.IORef import Data.List as X import Data.Maybe as X import Text.Show.Pretty as X (ppShow)@@ -58,50 +54,28 @@ b9VersionString :: String b9VersionString = showVersion version --- | A data structure that contains the `B9Invokation`--- as well as build parameters.-data B9RunParameters a =-  B9RunParameters-            B9ConfigOverride-            (B9Invokation a)-            BuildVariables---- | Run a b9 build.--- Return `True` if the build was successful.-runB9 :: B9RunParameters a -> IO (a, Bool)-runB9 (B9RunParameters overrides action vars) = do-  invokeB9 $ do-    modifyInvokationConfig-      (over envVars (++ vars) . const (overrides ^. customB9Config))-    mapM_ overrideB9ConfigPath (overrides ^. customB9ConfigPath)-    action--defaultB9RunParameters :: B9Invokation a -> B9RunParameters a-defaultB9RunParameters ba =-  B9RunParameters (B9ConfigOverride Nothing mempty) ba mempty--runShowVersion :: B9Invokation ()-runShowVersion = doAfterConfiguration $ do+runShowVersion :: B9Invokation Bool ()+runShowVersion = doAfterConfiguration $ const $ do   liftIO $ putStrLn b9VersionString   return True -runBuildArtifacts :: [FilePath] -> B9Invokation ()+runBuildArtifacts :: [FilePath] -> B9Invokation String () runBuildArtifacts buildFiles = do   generators <- mapM consult buildFiles   buildArtifacts (mconcat generators) -runFormatBuildFiles :: [FilePath] -> B9Invokation ()-runFormatBuildFiles buildFiles = doAfterConfiguration $ liftIO $ do+runFormatBuildFiles :: [FilePath] -> B9Invokation Bool ()+runFormatBuildFiles buildFiles = doAfterConfiguration $ const $ liftIO $ do   generators <- mapM consult buildFiles   let generatorsFormatted = map ppShow (generators :: [ArtifactGenerator])   putStrLn `mapM` (generatorsFormatted)   (uncurry writeFile) `mapM` (buildFiles `zip` generatorsFormatted)   return True -runPush :: SharedImageName -> B9Invokation ()+runPush :: SharedImageName -> B9Invokation Bool () runPush name = do   modifyInvokationConfig (keepTempDirs .~ False)-  run $ do+  run $ const $ do     conf <- getConfig     if not (isJust (conf ^. repository))       then do@@ -113,13 +87,13 @@         return True  -runPull :: Maybe SharedImageName -> B9Invokation ()+runPull :: Maybe SharedImageName -> B9Invokation Bool () runPull mName = do   modifyInvokationConfig (keepTempDirs .~ False)-  run (pullRemoteRepos >> maybePullImage)+  run (const (pullRemoteRepos >> maybePullImage))   where maybePullImage = maybe (return True) pullLatestImage mName -runRun :: SharedImageName -> [String] -> B9Invokation ()+runRun :: SharedImageName -> [String] -> B9Invokation String () runRun (SharedImageName name) cmdAndArgs = do   modifyInvokationConfig     (Lens.set keepTempDirs False . Lens.set interactive True)@@ -138,12 +112,12 @@     cmdAndArgs' = if null cmdAndArgs then ["/usr/bin/zsh"] else cmdAndArgs  -runGcLocalRepoCache :: B9Invokation ()+runGcLocalRepoCache :: B9Invokation Bool () runGcLocalRepoCache = do   modifyInvokationConfig (keepTempDirs .~ False)   impl  where-  impl = run $ do+  impl = run $ const $ do     toDelete <- (obsoleteSharedmages . map snd)       <$> lookupSharedImages (== Cache) (const True)     imgDir <- getSharedImagesCacheDir@@ -169,19 +143,19 @@     handleExists e | isDoesNotExistError e = return ()                    | otherwise             = throwIO e -runGcRemoteRepoCache :: B9Invokation ()+runGcRemoteRepoCache :: B9Invokation Bool () runGcRemoteRepoCache = do   modifyInvokationConfig (keepTempDirs .~ False)-  run $ do+  run $ const $ do     repos <- getSelectedRepos     cache <- getRepoCache     mapM_ (cleanRemoteRepo cache) repos     return True -runListSharedImages :: B9Invokation ()+runListSharedImages :: B9Invokation [SharedImage] () runListSharedImages = do   modifyInvokationConfig (keepTempDirs .~ False)-  run $ do+  run $ const $ do     remoteRepo <- getSelectedRemoteRepo     let repoPred = maybe (== Cache) ((==) . toRemoteRepository) remoteRepo     allRepos <- getRemoteRepos@@ -203,10 +177,10 @@       else liftIO $ do         putStrLn ""         putStrLn $ prettyPrintSharedImages $ map snd imgs-    return True+    return $ map snd imgs  -runAddRepo :: RemoteRepo -> B9Invokation ()+runAddRepo :: RemoteRepo -> B9Invokation Bool () runAddRepo repo = do   repo' <- remoteRepoCheckSshPrivKey repo   modifyPermanentConfig@@ -217,22 +191,18 @@     )  runLookupLocalSharedImage-  :: SharedImageName -> B9Invokation (Maybe SharedImageBuildId)-runLookupLocalSharedImage n = do-  ref <- liftIO (newIORef Nothing)-  run (go ref)-  liftIO (readIORef ref)+  :: SharedImageName -> B9Invokation (Maybe SharedImageBuildId) ()+runLookupLocalSharedImage n = run $ const $ do+  traceL (printf "Searching for cached image: %s" (show n))+  imgs <- lookupSharedImages isAvailableOnLocalHost hasTheDesiredName+  traceL "Candidate images: "+  traceL (printf "%s\n" (prettyPrintSharedImages (map snd imgs)))+  let res = extractNewestImageFromResults imgs+  traceL (printf "Returning result: %s" (show res))+  return res  where-  go ref = do-    res <--      extractNewestImageFromResults-        <$> lookupSharedImages isAvailableOnLocalHost hasTheDesiredName-    liftIO $ writeIORef ref res-    return True-   where-    extractNewestImageFromResults =-      listToMaybe . map toBuildId . take 1 . reverse . map snd-        where toBuildId (SharedImage _ _ i _ _) = i-    isAvailableOnLocalHost = (Cache ==)-    hasTheDesiredName (SharedImage n' _ _ _ _) = n == n'-+  extractNewestImageFromResults =+    listToMaybe . map toBuildId . take 1 . reverse . map snd+    where toBuildId (SharedImage _ _ i _ _) = i+  isAvailableOnLocalHost = (Cache ==)+  hasTheDesiredName (SharedImage n' _ _ _ _) = n == n'

@@ -57,13 +57,14 @@              String   deriving (Eq,Show) -run :: B9 Bool -> B9Invokation ()-run action = doAfterConfiguration $ do+run :: (Maybe a -> B9 a) -> B9Invokation a ()+run actionFunction = doAfterConfiguration $ \previousResult -> do   cfg <- ask   liftIO $ do     buildId <- generateBuildId     now     <- getCurrentTime-    withBuildDir cfg buildId (withLogFile cfg . run' cfg buildId now)+    let action = actionFunction previousResult+    withBuildDir cfg buildId (withLogFile cfg . runImpl action cfg buildId now)  where   withLogFile cfg f = maybe     (f Nothing)@@ -71,12 +72,12 @@     (_logFile cfg)   withBuildDir cfg buildId =     bracket (createBuildDir cfg buildId) (removeBuildDir cfg)-  run' cfg  buildId now buildDir logFileHandle = do+  runImpl action cfg buildId now buildDir logFileHandle = do     maybe (return ()) setCurrentDirectory (_buildDirRoot cfg)     -- Check repositories     repoCache <- initRepoCache       (fromMaybe defaultRepositoryCache (_repositoryCache cfg))-    let buildDate   = formatTime undefined "%F-%T" now+    let buildDate = formatTime undefined "%F-%T" now     remoteRepos' <- mapM (initRemoteRepo repoCache) (_remoteRepos cfg)     let       ctx = BuildState buildId@@ -97,7 +98,7 @@             sel             (show remoteRepos')           )-    (r, ctxOut) <- runStateT (runB9 wrappedAction) ctx+    (r, ctxOut) <- runStateT (runB9 (wrappedAction action)) ctx     -- Write a profiling report     when (isJust (_profileFile cfg)) $ writeFile       (fromJust (_profileFile cfg))@@ -126,7 +127,7 @@       $ removeDirectoryRecursive buildDir   generateBuildId = printf "%08X" <$> (randomIO :: IO Word32)   -- Run the action build action-  wrappedAction   = do+  wrappedAction action = do     startTime <- gets bsStartTime     r         <- action     now       <- liftIO getCurrentTime@@ -134,7 +135,7 @@     infoL (printf "DURATION: %s" duration)     return r -getBuildId :: B9 FilePath+getBuildId :: B9 String getBuildId = gets bsBuildId  getBuildDate :: B9 String@@ -207,7 +208,7 @@     lv  <- gets $ _verbosity . bsCfg     lfh <- gets bsLogFileHandle     return $ \level -> CL.mapM_ (logImpl lv lfh level . B.unpack)-  checkExitCode ExitSuccess        =+  checkExitCode ExitSuccess =     traceL $ printf "COMMAND '%s' exited with exit code: 0" cmdStr   checkExitCode ec@(ExitFailure e) = do     errorL $ printf "COMMAND '%s' exited with exit code: %i" cmdStr e@@ -266,6 +267,12 @@        let durMS = IoActionDuration (stop `diffUTCTime` start)        modify $ \ctx -> ctx {bsProf = durMS : bsProf ctx}        return res++++++   

@@ -30,11 +30,12 @@ import Control.Monad.IO.Class import System.Directory -buildArtifacts :: ArtifactGenerator -> B9Invokation ()-buildArtifacts artifactGenerator = run $ do+-- | Execute an 'ArtifactGenerator' and return a 'B9Invokation' that returns+-- the build id obtained by 'getBuildId'.+buildArtifacts :: ArtifactGenerator -> B9Invokation String ()+buildArtifacts artifactGenerator = run $ const $ do   traceL . ("CWD: " ++) =<< liftIO getCurrentDirectory   infoL "BUILDING ARTIFACTS"   getConfig >>= traceL . printf "USING BUILD CONFIGURATION: %v" . ppShow   assemble artifactGenerator-  return True-+  getBuildId

@@ -1,7 +1,8 @@ module B9.Invokation ( B9Invokation()                      , invokeB9-                     , invokeB9_                      , overrideWorkingDirectory+                     , mergeAfterConfigurationActionResults+                     , ignoreActionResults                      , doAfterConfiguration                      , overrideB9ConfigPath                      , modifyInvokationConfig@@ -23,27 +24,26 @@ -- build actions are performed. Use 'invokeB9' to execute these things. -- Inside the 'B9Invokation' monad you can influence and inspect the b9 -- configuration, the permanent, as well as the transient.-newtype B9Invokation a = B9Inv {runB9Invokation :: StateT InternalState IO a}-  deriving (MonadState InternalState, Monad, Applicative, Functor, MonadIO)+newtype B9Invokation res a = B9Inv {runB9Invokation :: StateT (InternalState res) IO a}+  deriving (MonadState (InternalState res), Monad, Applicative, Functor, MonadIO)  -- | Internal state of the 'B9Invokation'-data InternalState = IS { _initialConfigOverride   :: B9ConfigOverride-                        , _permanentB9ConfigUpdate :: Maybe (ConfigParser -> Either CPError ConfigParser)-                        , _changeWorkingDirectory  :: Maybe FilePath-                        , _buildAction             :: ReaderT B9Config IO Bool-                        }+data InternalState a = IS { _initialConfigOverride   :: B9ConfigOverride+                          , _permanentB9ConfigUpdate :: Maybe (ConfigParser -> Either CPError ConfigParser)+                          , _changeWorkingDirectory  :: Maybe FilePath+                          , _buildAction             :: Maybe (ReaderT B9Config IO a)+                          }  makeLenses ''InternalState -initialState :: InternalState-initialState =-    IS (B9ConfigOverride Nothing mempty) Nothing Nothing (return True)+initialState :: InternalState a+initialState = IS (B9ConfigOverride Nothing mempty) Nothing Nothing Nothing  -- | Run a 'B9Invokation'. -- If the user has no B9 config file yet, a default config file will be created.-invokeB9 :: B9Invokation a -> IO (a, Bool)+invokeB9 :: B9Invokation res () -> IO (Maybe res) invokeB9 act = do-    (a, st) <- runStateT (runB9Invokation act) initialState+    st <- execStateT (runB9Invokation act) initialState     let cfgPath = st ^. initialConfigOverride . customB9ConfigPath     cp0 <- openOrCreateB9Config cfgPath     let cpExtErr = fmap ($ cp0) (st ^. permanentB9ConfigUpdate)@@ -62,7 +62,8 @@     case parseB9Config cp of         Left e -> fail (printf "Configuration error: %s\n" (show e))         Right permanentConfig -> do-            let runtimeCfg =+            let+                runtimeCfg =                     permanentConfig                         Sem.<> st                         ^.     initialConfigOverride@@ -74,43 +75,79 @@                         ( do                             mapM_ setCurrentDirectory                                   (st ^. changeWorkingDirectory)-                            runReaderT (st ^. buildAction) runtimeCfg+                            runReaderT (sequence (st ^. buildAction)) runtimeCfg                         )                     )-            res <- completeBuildAction-            return (a, res)---- | Run a 'B9Invokation' and ignore the results of the invokation monad and--- instead return the results of the '_buildAction'.--- See: 'invokeB9'-invokeB9_ :: B9Invokation a -> IO Bool-invokeB9_ act = snd <$> invokeB9 act+            completeBuildAction  -- | Add an action to be executed once the configuration has been done.-doAfterConfiguration :: ReaderT B9Config IO Bool -> B9Invokation ()-doAfterConfiguration action = buildAction %= (>> action)+-- The action will be called with the result of the previous action defined by+-- this function. In case this is the first action added 'Nothing' is passed.+doAfterConfiguration :: (Maybe a -> ReaderT B9Config IO a) -> B9Invokation a ()+doAfterConfiguration action = buildAction %= appendOrSet+  where+    appendOrSet Nothing  = Just (action Nothing)+    appendOrSet (Just x) = Just (x >>= action . Just) +-- | Combine the result of a given 'B9Invokation' and the results of the action+-- defined by 'doAfterConfiguration' in the current state.+mergeAfterConfigurationActionResults+    :: (Maybe a -> Maybe b -> ReaderT B9Config IO b)+    -> B9Invokation a ()+    -> B9Invokation b ()+mergeAfterConfigurationActionResults f ba = do+    st <- liftIO $ execStateT (runB9Invokation ba) initialState+    let fb mbAction = Just $ do+            ma <- sequence (st ^. buildAction)+            mb <- sequence mbAction+            f ma mb+    buildAction %= fb++-- | Ignore the results of the actions defined by 'doAfterConfiguration'.+-- All actions will be executed, but the result will be replaced with '()'.+ignoreActionResults :: B9Invokation a () -> B9Invokation () ()+ignoreActionResults =+    mergeAfterConfigurationActionResults (const (const (return ())))+ -- | Override the B9 configuration path-overrideB9ConfigPath :: SystemPath -> B9Invokation ()+overrideB9ConfigPath :: SystemPath -> B9Invokation a () overrideB9ConfigPath p = initialConfigOverride . customB9ConfigPath .= Just p  -- | Override the current working directory during execution of the actions -- added with 'doAfterConfiguration'.-overrideWorkingDirectory :: FilePath -> B9Invokation ()+overrideWorkingDirectory :: FilePath -> B9Invokation a () overrideWorkingDirectory p = changeWorkingDirectory .= Just p  -- | Modify the current 'B9Config'. The modifications are not reflected in the -- config file or the 'ConfigParser' returned by 'askInvokationConfigParser'.-modifyInvokationConfig :: (B9Config -> B9Config) -> B9Invokation ()+modifyInvokationConfig :: (B9Config -> B9Config) -> B9Invokation a () modifyInvokationConfig f = initialConfigOverride . customB9Config %= f  -- | Modify the current 'B9Config'. The modifications are not reflected in the -- config file or the 'ConfigParser' returned by 'askInvokationConfigParser'.-modifyPermanentConfig :: (B9Config -> B9Config) -> B9Invokation ()+modifyPermanentConfig :: (B9Config -> B9Config) -> B9Invokation a () modifyPermanentConfig g = permanentB9ConfigUpdate %= go   where     go Nothing  = go (Just return)     go (Just f) = Just (\cp -> f cp >>= modifyConfigParser g)++++++++++++++++++   

@@ -6,18 +6,20 @@ import B9  -- | Convert a 'B9Invokation' action into a Shake 'Action'.-b9InvokationAction :: B9Invokation a -> Action (a, Bool)-b9InvokationAction = liftIO . runB9 . defaultB9RunParameters+b9InvokationAction :: B9Invokation a () -> Action a+b9InvokationAction invokationAction = do+    mres <- liftIO (invokeB9 invokationAction)+    maybe (fail "ERROR: Internal error while invoking a b9 action!") return mres  -- | An action that does the equivalent of -- @b9c build -f <b9file> -- (args !! 0) (args !! 1) ... (args !! (length args - 1))@ -- with the current working directory changed to @b9Root@.-buildB9File :: FilePath -> FilePath -> [String] -> Action ()+-- The return value is the buildid, see 'getBuildId'+buildB9File :: FilePath -> FilePath -> [String] -> Action String buildB9File b9Root b9File args = do     let f = b9Root </> b9File     need [f]-    (_, success) <- b9InvokationAction $ do+    b9InvokationAction $ do         modifyInvokationConfig (appendPositionalArguments args)         overrideWorkingDirectory b9Root         runBuildArtifacts [f]-    if success then return () else fail $ "ERROR: Build failed: " ++ f

@@ -22,47 +22,35 @@      -> Maybe ByteString.ByteString      -> Bool      -> Action (RunResult SharedImageBuildId)-  go nameQ mSerlializedBuildId dependenciesChanged = do-    (mCurrentBuildId, success) <- b9InvokationAction (runLookupLocalSharedImage nameQ)-    unless success-      (internalErrorSharedImageNotFound nameQ)--    case (decodeBuildId <$> mSerlializedBuildId, mCurrentBuildId) of--      (Nothing, Nothing) ->-        do newBuildId <- rebuild-           return (RunResult ChangedRecomputeDiff (encodeBuildId newBuildId) newBuildId)--      (Nothing, Just currentBuildId) ->-        if dependenciesChanged then-          do newBuildId <- rebuild-             let changed = if newBuildId == currentBuildId-                                 then ChangedStore-                                 else ChangedRecomputeDiff-             return (RunResult changed (encodeBuildId newBuildId) newBuildId)-        else-          return (RunResult ChangedStore (encodeBuildId currentBuildId) currentBuildId)--      (Just oldBuildId, Nothing) ->-          do newBuildId <- rebuild-             let changed = if oldBuildId == newBuildId-                                 then ChangedRecomputeSame-                                 else ChangedRecomputeDiff-             return (RunResult changed (encodeBuildId newBuildId) newBuildId)--      (Just oldBuildId, Just currentBuildId) ->-        do newBuildId <- if dependenciesChanged-                            then rebuild-                            else return currentBuildId-           let changed = if oldBuildId == newBuildId-                               then if dependenciesChanged-                                       then ChangedRecomputeSame-                                       else ChangedNothing-                               else ChangedRecomputeDiff--           return (RunResult changed (encodeBuildId newBuildId) newBuildId)-+  go nameQ mSerlializedBuildId dependenciesChanged =+    let mOld = decodeBuildId <$> mSerlializedBuildId+        in do+          (rebuilt, newBuildId) <-+           if dependenciesChanged then     (True,) <$> rebuild+             else+              do mNewBuildId <- getImgBuildId+                 maybe ((\i -> (True, i)) <$> rebuild)+                          (\i -> return (False, i))+                          mNewBuildId+          let newBuildIdBin = encodeBuildId newBuildId+              change =+                        if rebuilt then+                          maybe ChangedRecomputeDiff+                                    (\buildIdChanged ->+                                      if buildIdChanged then  ChangedRecomputeSame+                                           else ChangedRecomputeSame )+                                    ((/= newBuildId) <$> mOld)+                         else+                           maybe ChangedStore+                                 (\buildIdChanged ->+                                  if buildIdChanged then  ChangedRecomputeSame+                                        else ChangedRecomputeSame )+                                 ((/= newBuildId) <$> mOld)+              result = RunResult change newBuildIdBin newBuildId+          return result     where+      getImgBuildId = b9InvokationAction (runLookupLocalSharedImage nameQ)+       decodeBuildId :: ByteString.ByteString -> SharedImageBuildId       decodeBuildId = Binary.decode . LazyByteString.fromStrict @@ -91,30 +79,24 @@ -- NOTE: You must call 'enableSharedImageRules' before this action works. customSharedImageAction :: SharedImageName -> Action () -> Rules () customSharedImageAction b9img customAction =-  addUserRule $ SharedImageCustomActionRule b9img $ do-    customAction-    (after, success) <- b9InvokationAction (runLookupLocalSharedImage b9img)-    unless success-      (internalErrorSharedImageNotFound b9img)-    maybe-      (errorSharedImageNotFound b9img)-      return-      after+  addUserRule (SharedImageCustomActionRule b9img customAction')+  where+    customAction' = do+      customAction+      mCurrentBuildId <- b9InvokationAction (runLookupLocalSharedImage b9img)+      putLoud (printf "Finished custom action, for %s, build-id is: %s"+                      (show b9img) (show mCurrentBuildId))+      maybe (errorSharedImageNotFound b9img) return mCurrentBuildId + type instance RuleResult SharedImageName = SharedImageBuildId  data SharedImageCustomActionRule =   SharedImageCustomActionRule SharedImageName (Action SharedImageBuildId)   deriving Typeable -internalErrorSharedImageNotFound :: Monad m => SharedImageName -> m a-internalErrorSharedImageNotFound =-  fail-  . printf "Internal Error: SharedImage %s not found. Please report this."-  . show- errorSharedImageNotFound :: Monad m => SharedImageName -> m a errorSharedImageNotFound =   fail-  . printf "Error: SharedImage %s not found."+  . printf "Error: %s not found."   . show

@@ -1,6 +1,7 @@ flags: {} packages: - '.'-extra-deps: []+extra-deps:+- shake-0.16.3 resolver: lts-9.4 # pvp-bounds: lower