-- | Convenient Shake 'Action's for 'B9' rules.
module B9.Shake.Actions
  ( b9InvocationAction,
    buildB9File,
  )
where

import B9
import Control.Lens ((?~))
import Development.Shake
import GHC.Stack

-- | Convert a 'B9ConfigAction' action into a Shake 'Action'. This is just
-- an alias for 'runB9ConfigActionWithOverrides' since 'Action' is an instance of 'MonadIO'
-- and 'runB9ConfigActionWithOverrides' work on any .
b9InvocationAction :: HasCallStack => B9ConfigAction a -> B9ConfigOverride -> Action a
b9InvocationAction :: B9ConfigAction a -> B9ConfigOverride -> Action a
b9InvocationAction B9ConfigAction a
x B9ConfigOverride
y = IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (B9ConfigAction a -> B9ConfigOverride -> IO a
forall a.
HasCallStack =>
B9ConfigAction a -> B9ConfigOverride -> IO a
runB9ConfigActionWithOverrides B9ConfigAction a
x B9ConfigOverride
y)

-- | An action that does the equivalent of
-- @b9c build -f <b9file> -- (args !! 0) (args !! 1) ... (args !! (length args - 1))@
-- with the current working directory changed to @b9Root@.
-- The return value is the buildid, see 'getBuildId'
buildB9File :: HasCallStack => FilePath -> FilePath -> [String] -> Action String
buildB9File :: FilePath -> FilePath -> [FilePath] -> Action FilePath
buildB9File FilePath
b9Root FilePath
b9File [FilePath]
args = do
  let f :: FilePath
f = FilePath
b9Root FilePath -> FilePath -> FilePath
</> FilePath
b9File
  HasCallStack => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
f]
  IO FilePath -> Action FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    ( B9ConfigAction FilePath -> IO FilePath
forall a. HasCallStack => B9ConfigAction a -> IO a
runB9ConfigAction
        ( [FilePath] -> B9ConfigAction FilePath -> B9ConfigAction FilePath
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
[FilePath] -> Eff e a -> Eff e a
addLocalPositionalArguments
            [FilePath]
args
            ((B9Config -> B9Config)
-> B9ConfigAction FilePath -> B9ConfigAction FilePath
forall (e :: [* -> *]) a.
Member B9ConfigReader e =>
(B9Config -> B9Config) -> Eff e a -> Eff e a
localB9Config ((Maybe FilePath -> Identity (Maybe FilePath))
-> B9Config -> Identity B9Config
Lens' B9Config (Maybe FilePath)
projectRoot ((Maybe FilePath -> Identity (Maybe FilePath))
 -> B9Config -> Identity B9Config)
-> FilePath -> B9Config -> B9Config
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ FilePath
b9Root) ([FilePath] -> B9ConfigAction FilePath
runBuildArtifacts [FilePath
f]))
        )
    )