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