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 Data.Function
import B9
enableSharedImageRules :: B9ConfigOverride -> Rules ()
enableSharedImageRules b9inv = addBuiltinRule noLint sharedImageIdentity go
where
sharedImageIdentity :: BuiltinIdentity SharedImageName SharedImageBuildId
sharedImageIdentity (SharedImageName k) (SharedImageBuildId v) =
LazyByteString.toStrict
(Builder.toLazyByteString (stringUtf8 k <> stringUtf8 v))
go :: BuiltinRun SharedImageName SharedImageBuildId
go nameQ mSerlializedBuildId dependenciesChanged =
let mOld = decodeBuildId <$> mSerlializedBuildId
in do
(rebuilt, newBuildId) <-
if dependenciesChanged == RunDependenciesChanged
then (True, ) <$> rebuild
else do
mNewBuildId <- getImgBuildId
maybe ((True, ) <$> rebuild) (return . (False, )) mNewBuildId
let newBuildIdBin = encodeBuildId newBuildId
change = if rebuilt
then maybe
ChangedRecomputeDiff
(\buildIdChanged -> if buildIdChanged
then ChangedRecomputeDiff
else ChangedRecomputeSame
)
((/= newBuildId) <$> mOld)
else maybe
ChangedStore
(\buildIdChanged -> if buildIdChanged
then ChangedRecomputeDiff
else ChangedRecomputeSame
)
((/= newBuildId) <$> mOld)
result = RunResult change newBuildIdBin newBuildId
return result
where
getImgBuildId = execB9ConfigAction (runLookupLocalSharedImage nameQ) b9inv
decodeBuildId :: ByteString.ByteString -> SharedImageBuildId
decodeBuildId = Binary.decode . LazyByteString.fromStrict
encodeBuildId :: SharedImageBuildId -> ByteString.ByteString
encodeBuildId = LazyByteString.toStrict . Binary.encode
rebuild :: Action SharedImageBuildId
rebuild = do
rules <- getUserRuleList imgMatch
case sortBy (compare `on` fst) rules of
[] ->
fail $ "No rules to build B9 shared image " ++ show nameQ ++ " found"
[(_, act)] -> act b9inv
_rs ->
fail
$ "Multiple rules for the B9 shared image "
++ show nameQ
++ " found"
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