module B9.Shake.SharedImageRules
( customSharedImageAction
, needSharedImage
, enableSharedImageRules
) where
import B9
import qualified Data.Binary as Binary
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as Builder
import Data.ByteString.Builder (stringUtf8)
import qualified Data.ByteString.Lazy as LazyByteString
import Development.Shake
import Development.Shake.Classes
import Development.Shake.Rule
enableSharedImageRules :: B9ConfigOverride -> Rules ()
enableSharedImageRules b9inv = addBuiltinRule noLint sharedImageIdentity go
where
sharedImageIdentity :: BuiltinIdentity SharedImageName SharedImageBuildId
sharedImageIdentity (SharedImageName k) (SharedImageBuildId v) =
Just (LazyByteString.toStrict (Builder.toLazyByteString (stringUtf8 k <> stringUtf8 v)))
go :: BuiltinRun SharedImageName SharedImageBuildId
go nameQ mOldBIdBinary dependenciesChanged = do
mCurrentBId <- getImgBuildId
case mCurrentBId of
Just currentBId ->
let currentBIdBinary = encodeBuildId currentBId
in if dependenciesChanged == RunDependenciesChanged && mOldBIdBinary == Just currentBIdBinary
then return $ RunResult ChangedNothing currentBIdBinary currentBId
else rebuild (Just currentBIdBinary)
_ -> 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 :: SharedImageName -> Action SharedImageBuildId
needSharedImage = apply1
customSharedImageAction :: 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 :: Monad m => SharedImageName -> m a
errorSharedImageNotFound = fail . printf "Error: %s not found." . show