module B9.Shake.SharedImageRules
( customSharedImageAction
, needSharedImage
, enableSharedImageRules
)
where
import Development.Shake
import Development.Shake.Classes
import Development.Shake.Rule
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 qualified Data.Binary as Binary
import B9
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 = execB9ConfigAction (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 <- execB9ConfigAction (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