-- | A crude, unsafe and preliminary solution to building B9 'SharedImage's
-- from Shake.
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

-- | In order to use 'needSharedImage' and 'customSharedImageAction' you need to
-- call this action before using any of the aforementioned 'Rules'.
enableSharedImageRules :: HasCallStack => B9ConfigOverride -> Rules ()
enableSharedImageRules :: B9ConfigOverride -> Rules ()
enableSharedImageRules B9ConfigOverride
b9inv = BuiltinLint SharedImageName SharedImageBuildId
-> BuiltinIdentity SharedImageName SharedImageBuildId
-> BuiltinRun SharedImageName SharedImageBuildId
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
 NFData value, Show value, Partial) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule BuiltinLint SharedImageName SharedImageBuildId
forall key value. BuiltinLint key value
noLint BuiltinIdentity SharedImageName SharedImageBuildId
forall key value. BuiltinIdentity key value
noIdentity BuiltinRun SharedImageName SharedImageBuildId
go
  where
    go :: BuiltinRun SharedImageName SharedImageBuildId
    go :: BuiltinRun SharedImageName SharedImageBuildId
go SharedImageName
nameQ Maybe ByteString
mOldBIdBinary RunMode
dependenciesChanged = do
      Maybe SharedImageBuildId
mCurrentBId <- Action (Maybe SharedImageBuildId)
getImgBuildId
      let mCurrentBIdBinary :: Maybe ByteString
mCurrentBIdBinary = SharedImageBuildId -> ByteString
encodeBuildId (SharedImageBuildId -> ByteString)
-> Maybe SharedImageBuildId -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SharedImageBuildId
mCurrentBId
      String -> Action ()
putLoud (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$
        String
"share image rule for: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ SharedImageName -> String
forall a. Show a => a -> String
show SharedImageName
nameQ
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Deps: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ RunMode -> String
forall a. Show a => a -> String
show RunMode
dependenciesChanged
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", current BId: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe SharedImageBuildId -> String
forall a. Show a => a -> String
show Maybe SharedImageBuildId
mCurrentBId
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Binary: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe ByteString -> String
forall a. Show a => a -> String
show Maybe ByteString
mCurrentBIdBinary
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", old BId: "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe ByteString -> String
forall a. Show a => a -> String
show Maybe ByteString
mOldBIdBinary
      case Maybe ByteString
mCurrentBIdBinary of
        Just ByteString
currentBIdBinary ->
          if RunMode
dependenciesChanged RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame Bool -> Bool -> Bool
&& Maybe ByteString
mOldBIdBinary Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
currentBIdBinary
            then RunResult SharedImageBuildId
-> Action (RunResult SharedImageBuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return (RunResult SharedImageBuildId
 -> Action (RunResult SharedImageBuildId))
-> RunResult SharedImageBuildId
-> Action (RunResult SharedImageBuildId)
forall a b. (a -> b) -> a -> b
$ RunChanged
-> ByteString -> SharedImageBuildId -> RunResult SharedImageBuildId
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
currentBIdBinary (Maybe SharedImageBuildId -> SharedImageBuildId
forall a. Partial => Maybe a -> a
fromJust Maybe SharedImageBuildId
mCurrentBId)
            else Maybe ByteString -> Action (RunResult SharedImageBuildId)
rebuild (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
currentBIdBinary)
        Maybe ByteString
Nothing -> Maybe ByteString -> Action (RunResult SharedImageBuildId)
rebuild Maybe ByteString
forall a. Maybe a
Nothing
      where
        getImgBuildId :: Action (Maybe SharedImageBuildId)
getImgBuildId = IO (Maybe SharedImageBuildId) -> Action (Maybe SharedImageBuildId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (B9ConfigAction (Maybe SharedImageBuildId)
-> B9ConfigOverride -> IO (Maybe SharedImageBuildId)
forall a. Partial => B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides (SharedImageName -> B9ConfigAction (Maybe SharedImageBuildId)
runLookupLocalSharedImage SharedImageName
nameQ) B9ConfigOverride
b9inv)
        encodeBuildId :: SharedImageBuildId -> ByteString.ByteString
        encodeBuildId :: SharedImageBuildId -> ByteString
encodeBuildId = ByteString -> ByteString
LazyByteString.toStrict (ByteString -> ByteString)
-> (SharedImageBuildId -> ByteString)
-> SharedImageBuildId
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImageBuildId -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
        rebuild :: Maybe ByteString.ByteString -> Action (RunResult SharedImageBuildId)
        rebuild :: Maybe ByteString -> Action (RunResult SharedImageBuildId)
rebuild Maybe ByteString
mCurrentBIdBinary = do
          (Int
_, B9ConfigOverride -> Action SharedImageBuildId
act) <- SharedImageName
-> (SharedImageCustomActionRule -> Maybe String)
-> (SharedImageCustomActionRule
    -> Maybe (B9ConfigOverride -> Action SharedImageBuildId))
-> Action (Int, B9ConfigOverride -> Action SharedImageBuildId)
forall key a b.
(ShakeValue key, Typeable a) =>
key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Int, b)
getUserRuleOne SharedImageName
nameQ (Maybe String -> SharedImageCustomActionRule -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) SharedImageCustomActionRule
-> Maybe (B9ConfigOverride -> Action SharedImageBuildId)
imgMatch
          SharedImageBuildId
_ <- B9ConfigOverride -> Action SharedImageBuildId
act B9ConfigOverride
b9inv
          Maybe SharedImageBuildId
mNewBId <- Action (Maybe SharedImageBuildId)
getImgBuildId
          SharedImageBuildId
newBId <-
            Action SharedImageBuildId
-> (SharedImageBuildId -> Action SharedImageBuildId)
-> Maybe SharedImageBuildId
-> Action SharedImageBuildId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (String -> Action SharedImageBuildId
forall a. Partial => String -> a
error (String
"failed to get SharedImageBuildId for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SharedImageName -> String
forall a. Show a => a -> String
show SharedImageName
nameQ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in context of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ B9ConfigOverride -> String
forall a. Show a => a -> String
show B9ConfigOverride
b9inv))
              SharedImageBuildId -> Action SharedImageBuildId
forall (m :: * -> *) a. Monad m => a -> m a
return
              Maybe SharedImageBuildId
mNewBId
          let newBIdBinary :: ByteString
newBIdBinary = SharedImageBuildId -> ByteString
encodeBuildId SharedImageBuildId
newBId
          let change :: RunChanged
change =
                if ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
newBIdBinary Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
mCurrentBIdBinary
                  then RunChanged
ChangedRecomputeSame
                  else RunChanged
ChangedRecomputeDiff
          RunResult SharedImageBuildId
-> Action (RunResult SharedImageBuildId)
forall (m :: * -> *) a. Monad m => a -> m a
return (RunResult SharedImageBuildId
 -> Action (RunResult SharedImageBuildId))
-> RunResult SharedImageBuildId
-> Action (RunResult SharedImageBuildId)
forall a b. (a -> b) -> a -> b
$ RunChanged
-> ByteString -> SharedImageBuildId -> RunResult SharedImageBuildId
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
change ByteString
newBIdBinary SharedImageBuildId
newBId
          where
            imgMatch :: SharedImageCustomActionRule
-> Maybe (B9ConfigOverride -> Action SharedImageBuildId)
imgMatch (SharedImageCustomActionRule SharedImageName
name B9ConfigOverride -> Action SharedImageBuildId
mkImage) =
              if SharedImageName
name SharedImageName -> SharedImageName -> Bool
forall a. Eq a => a -> a -> Bool
== SharedImageName
nameQ
                then (B9ConfigOverride -> Action SharedImageBuildId)
-> Maybe (B9ConfigOverride -> Action SharedImageBuildId)
forall a. a -> Maybe a
Just B9ConfigOverride -> Action SharedImageBuildId
mkImage
                else Maybe (B9ConfigOverride -> Action SharedImageBuildId)
forall a. Maybe a
Nothing

-- | Add a dependency to the creation of a 'SharedImage'. The build action
-- for the shared image must have been supplied by e.g. 'customSharedImageAction'.
-- NOTE: You must call 'enableSharedImageRules' before this action works.
needSharedImage :: HasCallStack => SharedImageName -> Action SharedImageBuildId
needSharedImage :: SharedImageName -> Action SharedImageBuildId
needSharedImage = SharedImageName -> Action SharedImageBuildId
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1

-- | Specify an arbitrary action that is supposed to build the given shared
-- image identified by a 'SharedImageName'.
-- NOTE: You must call 'enableSharedImageRules' before this action works.
customSharedImageAction :: HasCallStack => SharedImageName -> Action () -> Rules ()
customSharedImageAction :: SharedImageName -> Action () -> Rules ()
customSharedImageAction SharedImageName
b9img Action ()
customAction = SharedImageCustomActionRule -> Rules ()
forall a. Typeable a => a -> Rules ()
addUserRule (SharedImageName
-> (B9ConfigOverride -> Action SharedImageBuildId)
-> SharedImageCustomActionRule
SharedImageCustomActionRule SharedImageName
b9img B9ConfigOverride -> Action SharedImageBuildId
customAction')
  where
    customAction' :: B9ConfigOverride -> Action SharedImageBuildId
customAction' B9ConfigOverride
b9inv = do
      Action ()
customAction
      Maybe SharedImageBuildId
mCurrentBuildId <- IO (Maybe SharedImageBuildId) -> Action (Maybe SharedImageBuildId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (B9ConfigAction (Maybe SharedImageBuildId)
-> B9ConfigOverride -> IO (Maybe SharedImageBuildId)
forall a. Partial => B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides (SharedImageName -> B9ConfigAction (Maybe SharedImageBuildId)
runLookupLocalSharedImage SharedImageName
b9img) B9ConfigOverride
b9inv)
      String -> Action ()
putLoud (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Finished custom action, for %s, build-id is: %s" (SharedImageName -> String
forall a. Show a => a -> String
show SharedImageName
b9img) (Maybe SharedImageBuildId -> String
forall a. Show a => a -> String
show Maybe SharedImageBuildId
mCurrentBuildId))
      Action SharedImageBuildId
-> (SharedImageBuildId -> Action SharedImageBuildId)
-> Maybe SharedImageBuildId
-> Action SharedImageBuildId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SharedImageName -> Action SharedImageBuildId
forall (m :: * -> *) a.
(Partial, Monad m) =>
SharedImageName -> m a
errorSharedImageNotFound SharedImageName
b9img) SharedImageBuildId -> Action SharedImageBuildId
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SharedImageBuildId
mCurrentBuildId

type instance RuleResult SharedImageName = SharedImageBuildId

data SharedImageCustomActionRule
  = SharedImageCustomActionRule
      SharedImageName
      (B9ConfigOverride -> Action SharedImageBuildId)
  deriving (Typeable)

errorSharedImageNotFound :: (HasCallStack, Monad m) => SharedImageName -> m a
errorSharedImageNotFound :: SharedImageName -> m a
errorSharedImageNotFound = String -> m a
forall a. Partial => String -> a
error (String -> m a)
-> (SharedImageName -> String) -> SharedImageName -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Error: %s not found." (String -> String)
-> (SharedImageName -> String) -> SharedImageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImageName -> String
forall a. Show a => a -> String
show