module B9.Shake.SharedImageRules
( customSharedImageAction
, needSharedImage
, enableSharedImageRules
) where
import B9
import qualified Data.Binary as Binary
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.ByteString.Lazy.Char8 as LazyByteString
import Development.Shake
import Development.Shake.Classes
import Development.Shake.Rule
import GHC.Stack
enableSharedImageRules :: HasCallStack => B9ConfigOverride -> Rules ()
enableSharedImageRules b9inv = addBuiltinRule noLint noIdentity go
where
go :: BuiltinRun SharedImageName SharedImageBuildId
go nameQ mOldBIdBinary dependenciesChanged = do
mCurrentBId <- getImgBuildId
let mCurrentBIdBinary = encodeBuildId <$> mCurrentBId
putLoud $
"share image rule for: " ++
show nameQ ++
". Deps: " ++
show dependenciesChanged ++
", current BId: " ++
show mCurrentBId ++ " Binary: " ++ show mCurrentBIdBinary ++ ", old BId: " ++ show mOldBIdBinary
case mCurrentBIdBinary of
Just currentBIdBinary ->
if dependenciesChanged == RunDependenciesSame && mOldBIdBinary == Just currentBIdBinary
then return $ RunResult ChangedNothing currentBIdBinary (fromJust mCurrentBId)
else rebuild (Just currentBIdBinary)
Nothing -> rebuild Nothing
where
getImgBuildId = liftIO (runB9ConfigActionWithOverrides (runLookupLocalSharedImage nameQ) b9inv)
encodeBuildId :: SharedImageBuildId -> ByteString.ByteString
encodeBuildId = LazyByteString.toStrict . Binary.encode
rebuild :: Maybe ByteString.ByteString -> Action (RunResult SharedImageBuildId)
rebuild mCurrentBIdBinary = do
(_, act) <- getUserRuleOne nameQ (const Nothing) imgMatch
act b9inv
mNewBId <- getImgBuildId
newBId <-
maybe
(error ("failed to get SharedImageBuildId for " ++ show nameQ ++ " in context of " ++ show b9inv))
return
mNewBId
let newBIdBinary = encodeBuildId newBId
let change =
if Just newBIdBinary == mCurrentBIdBinary
then ChangedRecomputeSame
else ChangedRecomputeDiff
return $ RunResult change newBIdBinary newBId
where
imgMatch (SharedImageCustomActionRule name mkImage) =
if name == nameQ
then Just mkImage
else Nothing
needSharedImage :: HasCallStack => SharedImageName -> Action SharedImageBuildId
needSharedImage = apply1
customSharedImageAction :: HasCallStack => SharedImageName -> Action () -> Rules ()
customSharedImageAction b9img customAction = addUserRule (SharedImageCustomActionRule b9img customAction')
where
customAction' b9inv = do
customAction
mCurrentBuildId <- liftIO (runB9ConfigActionWithOverrides (runLookupLocalSharedImage b9img) b9inv)
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
(B9ConfigOverride -> Action SharedImageBuildId)
deriving (Typeable)
errorSharedImageNotFound :: (HasCallStack, Monad m) => SharedImageName -> m a
errorSharedImageNotFound = fail . printf "Error: %s not found." . show