{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds, NamedFieldPuns #-}
{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}

module Development.Shake.Internal.Core.Rules(
    Rules, SRules(..), runRules,
    RuleResult, addBuiltinRule, addBuiltinRuleEx,
    noLint, noIdentity,
    getShakeOptionsRules,
    getUserRuleInternal, getUserRuleOne, getUserRuleList, getUserRuleMaybe,
    addUserRule, alternatives, priority, versioned,
    getTargets, addTarget, withTargetDocs, withoutTargets,
    addHelpSuffix, getHelpSuffix,
    action, withoutActions
    ) where

import Control.Applicative
import Data.Tuple.Extra
import Control.Exception
import Control.Monad.Extra
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Development.Shake.Classes
import General.Binary
import General.Extra
import Data.Typeable
import Data.Data
import Data.List.Extra
import qualified Data.HashMap.Strict as Map
import qualified General.TypeMap as TMap
import Data.Maybe
import Data.IORef
import Data.Semigroup
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Binary.Builder as Bin
import Data.Binary.Put
import Data.Binary.Get
import General.ListBuilder
import Control.Monad.Fail
import Prelude

import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Monad
import Development.Shake.Internal.Value
import Development.Shake.Internal.Options
import Development.Shake.Internal.Errors


---------------------------------------------------------------------
-- RULES

-- | Get the 'ShakeOptions' that were used.
getShakeOptionsRules :: Rules ShakeOptions
getShakeOptionsRules :: Rules ShakeOptions
getShakeOptionsRules = ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ShakeOptions
-> Rules ShakeOptions
forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ShakeOptions
 -> Rules ShakeOptions)
-> ReaderT
     (ShakeOptions, IORef (SRules ListBuilder)) IO ShakeOptions
-> Rules ShakeOptions
forall a b. (a -> b) -> a -> b
$ ((ShakeOptions, IORef (SRules ListBuilder)) -> ShakeOptions)
-> ReaderT
     (ShakeOptions, IORef (SRules ListBuilder)) IO ShakeOptions
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (ShakeOptions, IORef (SRules ListBuilder)) -> ShakeOptions
forall a b. (a, b) -> a
fst


-- | Internal variant, more flexible, but not such a nice API
--   Same args as getuserRuleMaybe, but returns (guaranteed version, items, error to throw if wrong number)
--   Fields are returned lazily, in particular ver can be looked up cheaper
getUserRuleInternal :: forall key a b . (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal :: key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal key
key a -> Maybe String
disp a -> Maybe b
test = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Seconds
IO Progress
IORef [IO ()]
IORef [(Key, Key)]
HashMap TypeRep BuiltinRule
Cleanup
ShakeOptions
Database
Pool
Map UserRuleVersioned
Step
[String] -> [Key] -> Action [Value]
IO String -> IO ()
Key -> Action ()
Verbosity -> String -> IO ()
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Seconds
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Seconds
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} <- RAW ([String], [Key]) [Value] Global Local Global -> Action Global
forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action RAW ([String], [Key]) [Value] Global Local Global
forall k v ro rw. RAW k v ro rw ro
getRO
    let UserRuleVersioned Bool
versioned UserRule a
rules = UserRuleVersioned a
-> Maybe (UserRuleVersioned a) -> UserRuleVersioned a
forall a. a -> Maybe a -> a
fromMaybe UserRuleVersioned a
forall a. Monoid a => a
mempty (Maybe (UserRuleVersioned a) -> UserRuleVersioned a)
-> Maybe (UserRuleVersioned a) -> UserRuleVersioned a
forall a b. (a -> b) -> a -> b
$ Map UserRuleVersioned -> Maybe (UserRuleVersioned a)
forall a (f :: * -> *). Typeable a => Map f -> Maybe (f a)
TMap.lookup Map UserRuleVersioned
globalUserRules
    let ver :: Maybe Ver
ver = if Bool
versioned then Maybe Ver
forall a. Maybe a
Nothing else Ver -> Maybe Ver
forall a. a -> Maybe a
Just (Ver -> Maybe Ver) -> Ver -> Maybe Ver
forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
0
    let items :: [(Ver, Maybe String, b)]
items = [(Ver, Maybe String, b)]
-> [[(Ver, Maybe String, b)]] -> [(Ver, Maybe String, b)]
forall a. a -> [a] -> a
headDef [] ([[(Ver, Maybe String, b)]] -> [(Ver, Maybe String, b)])
-> [[(Ver, Maybe String, b)]] -> [(Ver, Maybe String, b)]
forall a b. (a -> b) -> a -> b
$ ((Seconds, [(Ver, Maybe String, b)]) -> [(Ver, Maybe String, b)])
-> [(Seconds, [(Ver, Maybe String, b)])]
-> [[(Ver, Maybe String, b)]]
forall a b. (a -> b) -> [a] -> [b]
map (Seconds, [(Ver, Maybe String, b)]) -> [(Ver, Maybe String, b)]
forall a b. (a, b) -> b
snd ([(Seconds, [(Ver, Maybe String, b)])]
 -> [[(Ver, Maybe String, b)]])
-> [(Seconds, [(Ver, Maybe String, b)])]
-> [[(Ver, Maybe String, b)]]
forall a b. (a -> b) -> a -> b
$ [(Seconds, [(Ver, Maybe String, b)])]
-> [(Seconds, [(Ver, Maybe String, b)])]
forall a. [a] -> [a]
reverse ([(Seconds, [(Ver, Maybe String, b)])]
 -> [(Seconds, [(Ver, Maybe String, b)])])
-> [(Seconds, [(Ver, Maybe String, b)])]
-> [(Seconds, [(Ver, Maybe String, b)])]
forall a b. (a -> b) -> a -> b
$ [(Seconds, (Ver, Maybe String, b))]
-> [(Seconds, [(Ver, Maybe String, b)])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort ([(Seconds, (Ver, Maybe String, b))]
 -> [(Seconds, [(Ver, Maybe String, b)])])
-> [(Seconds, (Ver, Maybe String, b))]
-> [(Seconds, [(Ver, Maybe String, b)])]
forall a b. (a -> b) -> a -> b
$ Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f (Int -> Ver
Ver Int
0) Maybe Seconds
forall a. Maybe a
Nothing UserRule a
rules
    let err :: SomeException
err = TypeRep -> String -> [Maybe String] -> SomeException
errorMultipleRulesMatch (key -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf key
key) (key -> String
forall a. Show a => a -> String
show key
key) (((Ver, Maybe String, b) -> Maybe String)
-> [(Ver, Maybe String, b)] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Ver, Maybe String, b) -> Maybe String
forall a b c. (a, b, c) -> b
snd3 [(Ver, Maybe String, b)]
items)
    (Maybe Ver, [(Int, b)], SomeException)
-> Action (Maybe Ver, [(Int, b)], SomeException)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Ver
ver, ((Ver, Maybe String, b) -> (Int, b))
-> [(Ver, Maybe String, b)] -> [(Int, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ver Int
v,Maybe String
_,b
x) -> (Int
v,b
x)) [(Ver, Maybe String, b)]
items, SomeException
err)
    where
        f :: Ver -> Maybe Double -> UserRule a -> [(Double,(Ver,Maybe String,b))]
        f :: Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v Maybe Seconds
p (UserRule a
x) = [(Seconds -> Maybe Seconds -> Seconds
forall a. a -> Maybe a -> a
fromMaybe Seconds
1 Maybe Seconds
p, (Ver
v,a -> Maybe String
disp a
x,b
x2)) | Just b
x2 <- [a -> Maybe b
test a
x]]
        f Ver
v Maybe Seconds
p (Unordered [UserRule a]
xs) = (UserRule a -> [(Seconds, (Ver, Maybe String, b))])
-> [UserRule a] -> [(Seconds, (Ver, Maybe String, b))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v Maybe Seconds
p) [UserRule a]
xs
        f Ver
v Maybe Seconds
p (Priority Seconds
p2 UserRule a
x) = Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v (Seconds -> Maybe Seconds
forall a. a -> Maybe a
Just (Seconds -> Maybe Seconds) -> Seconds -> Maybe Seconds
forall a b. (a -> b) -> a -> b
$ Seconds -> Maybe Seconds -> Seconds
forall a. a -> Maybe a -> a
fromMaybe Seconds
p2 Maybe Seconds
p) UserRule a
x
        f Ver
_ Maybe Seconds
p (Versioned Ver
v UserRule a
x) = Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v Maybe Seconds
p UserRule a
x
        f Ver
v Maybe Seconds
p (Alternative UserRule a
x) = Int
-> [(Seconds, (Ver, Maybe String, b))]
-> [(Seconds, (Ver, Maybe String, b))]
forall a. Int -> [a] -> [a]
take Int
1 ([(Seconds, (Ver, Maybe String, b))]
 -> [(Seconds, (Ver, Maybe String, b))])
-> [(Seconds, (Ver, Maybe String, b))]
-> [(Seconds, (Ver, Maybe String, b))]
forall a b. (a -> b) -> a -> b
$ Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v Maybe Seconds
p UserRule a
x


-- | Get the user rules that were added at a particular type which return 'Just' on a given function.
--   Return all equally applicable rules, paired with the version of the rule
--   (set by 'versioned'). Where rules are specified with 'alternatives' or 'priority'
--   the less-applicable rules will not be returned.
--
--   If you can only deal with zero/one results, call 'getUserRuleMaybe' or 'getUserRuleOne',
--   which raise informative errors.
getUserRuleList :: Typeable a => (a -> Maybe b) -> Action [(Int, b)]
getUserRuleList :: (a -> Maybe b) -> Action [(Int, b)]
getUserRuleList a -> Maybe b
test = (Maybe Ver, [(Int, b)], SomeException) -> [(Int, b)]
forall a b c. (a, b, c) -> b
snd3 ((Maybe Ver, [(Int, b)], SomeException) -> [(Int, b)])
-> Action (Maybe Ver, [(Int, b)], SomeException)
-> Action [(Int, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ()
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal () (Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) a -> Maybe b
test


-- | A version of 'getUserRuleList' that fails if there is more than one result
--   Requires a @key@ for better error messages.
getUserRuleMaybe :: (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Maybe (Int, b))
getUserRuleMaybe :: key
-> (a -> Maybe String) -> (a -> Maybe b) -> Action (Maybe (Int, b))
getUserRuleMaybe key
key a -> Maybe String
disp a -> Maybe b
test = do
    (Maybe Ver
_, [(Int, b)]
xs, SomeException
err) <- key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal key
key a -> Maybe String
disp a -> Maybe b
test
    case [(Int, b)]
xs of
        [] -> Maybe (Int, b) -> Action (Maybe (Int, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, b)
forall a. Maybe a
Nothing
        [(Int, b)
x] -> Maybe (Int, b) -> Action (Maybe (Int, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int, b) -> Action (Maybe (Int, b)))
-> Maybe (Int, b) -> Action (Maybe (Int, b))
forall a b. (a -> b) -> a -> b
$ (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int, b)
x
        [(Int, b)]
_ -> SomeException -> Action (Maybe (Int, b))
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
err

-- | A version of 'getUserRuleList' that fails if there is not exactly one result
--   Requires a @key@ for better error messages.
getUserRuleOne :: (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Int, b)
getUserRuleOne :: key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Int, b)
getUserRuleOne key
key a -> Maybe String
disp a -> Maybe b
test = do
    (Maybe Ver
_, [(Int, b)]
xs, SomeException
err) <- key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal key
key a -> Maybe String
disp a -> Maybe b
test
    case [(Int, b)]
xs of
        [(Int, b)
x] -> (Int, b) -> Action (Int, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int, b)
x
        [(Int, b)]
_ -> SomeException -> Action (Int, b)
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
err


-- | Define a set of rules. Rules can be created with calls to functions such as 'Development.Shake.%>' or 'action'.
--   Rules are combined with either the 'Monoid' instance, or (more commonly) the 'Monad' instance and @do@ notation.
--   To define your own custom types of rule, see "Development.Shake.Rule".
newtype Rules a = Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a) -- All IO must be associative/commutative (e.g. creating IORef/MVars)
    deriving (a -> Rules b -> Rules a
(a -> b) -> Rules a -> Rules b
(forall a b. (a -> b) -> Rules a -> Rules b)
-> (forall a b. a -> Rules b -> Rules a) -> Functor Rules
forall a b. a -> Rules b -> Rules a
forall a b. (a -> b) -> Rules a -> Rules b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Rules b -> Rules a
$c<$ :: forall a b. a -> Rules b -> Rules a
fmap :: (a -> b) -> Rules a -> Rules b
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
Functor, Functor Rules
a -> Rules a
Functor Rules
-> (forall a. a -> Rules a)
-> (forall a b. Rules (a -> b) -> Rules a -> Rules b)
-> (forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c)
-> (forall a b. Rules a -> Rules b -> Rules b)
-> (forall a b. Rules a -> Rules b -> Rules a)
-> Applicative Rules
Rules a -> Rules b -> Rules b
Rules a -> Rules b -> Rules a
Rules (a -> b) -> Rules a -> Rules b
(a -> b -> c) -> Rules a -> Rules b -> Rules c
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules (a -> b) -> Rules a -> Rules b
forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Rules a -> Rules b -> Rules a
$c<* :: forall a b. Rules a -> Rules b -> Rules a
*> :: Rules a -> Rules b -> Rules b
$c*> :: forall a b. Rules a -> Rules b -> Rules b
liftA2 :: (a -> b -> c) -> Rules a -> Rules b -> Rules c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
<*> :: Rules (a -> b) -> Rules a -> Rules b
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
pure :: a -> Rules a
$cpure :: forall a. a -> Rules a
$cp1Applicative :: Functor Rules
Applicative, Applicative Rules
a -> Rules a
Applicative Rules
-> (forall a b. Rules a -> (a -> Rules b) -> Rules b)
-> (forall a b. Rules a -> Rules b -> Rules b)
-> (forall a. a -> Rules a)
-> Monad Rules
Rules a -> (a -> Rules b) -> Rules b
Rules a -> Rules b -> Rules b
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules a -> (a -> Rules b) -> Rules b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Rules a
$creturn :: forall a. a -> Rules a
>> :: Rules a -> Rules b -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>>= :: Rules a -> (a -> Rules b) -> Rules b
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$cp1Monad :: Applicative Rules
Monad, Monad Rules
Monad Rules -> (forall a. IO a -> Rules a) -> MonadIO Rules
IO a -> Rules a
forall a. IO a -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Rules a
$cliftIO :: forall a. IO a -> Rules a
$cp1MonadIO :: Monad Rules
MonadIO, Monad Rules
Monad Rules
-> (forall a. (a -> Rules a) -> Rules a) -> MonadFix Rules
(a -> Rules a) -> Rules a
forall a. (a -> Rules a) -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Rules a) -> Rules a
$cmfix :: forall a. (a -> Rules a) -> Rules a
$cp1MonadFix :: Monad Rules
MonadFix, Monad Rules
Monad Rules -> (forall a. String -> Rules a) -> MonadFail Rules
String -> Rules a
forall a. String -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Rules a
$cfail :: forall a. String -> Rules a
$cp1MonadFail :: Monad Rules
Control.Monad.Fail.MonadFail)

newRules :: SRules ListBuilder -> Rules ()
newRules :: SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
x = ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
-> Rules ()
forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
 -> Rules ())
-> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
-> Rules ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ())
-> (IORef (SRules ListBuilder) -> IO ())
-> IORef (SRules ListBuilder)
-> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef (SRules ListBuilder)
 -> (SRules ListBuilder -> SRules ListBuilder) -> IO ())
-> (SRules ListBuilder -> SRules ListBuilder)
-> IORef (SRules ListBuilder)
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef (SRules ListBuilder)
-> (SRules ListBuilder -> SRules ListBuilder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
forall a. Semigroup a => a -> a -> a
<> SRules ListBuilder
x) (IORef (SRules ListBuilder)
 -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ())
-> ReaderT
     (ShakeOptions, IORef (SRules ListBuilder))
     IO
     (IORef (SRules ListBuilder))
-> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((ShakeOptions, IORef (SRules ListBuilder))
 -> IORef (SRules ListBuilder))
-> ReaderT
     (ShakeOptions, IORef (SRules ListBuilder))
     IO
     (IORef (SRules ListBuilder))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (ShakeOptions, IORef (SRules ListBuilder))
-> IORef (SRules ListBuilder)
forall a b. (a, b) -> b
snd

modifyRulesScoped :: (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped :: (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped SRules ListBuilder -> SRules ListBuilder
f (Rules ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
r) = ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
 -> Rules a)
-> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
-> Rules a
forall a b. (a -> b) -> a -> b
$ do
    (ShakeOptions
opts, IORef (SRules ListBuilder)
refOld) <- ReaderT
  (ShakeOptions, IORef (SRules ListBuilder))
  IO
  (ShakeOptions, IORef (SRules ListBuilder))
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    IO a -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a)
-> IO a -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
forall a b. (a -> b) -> a -> b
$ do
        IORef (SRules ListBuilder)
refNew <- SRules ListBuilder -> IO (IORef (SRules ListBuilder))
forall a. a -> IO (IORef a)
newIORef SRules ListBuilder
forall a. Monoid a => a
mempty
        a
res <- ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
-> (ShakeOptions, IORef (SRules ListBuilder)) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
r (ShakeOptions
opts, IORef (SRules ListBuilder)
refNew)
        SRules ListBuilder
rules <- IORef (SRules ListBuilder) -> IO (SRules ListBuilder)
forall a. IORef a -> IO a
readIORef IORef (SRules ListBuilder)
refNew
        IORef (SRules ListBuilder)
-> (SRules ListBuilder -> SRules ListBuilder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (SRules ListBuilder)
refOld (SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
forall a. Semigroup a => a -> a -> a
<> SRules ListBuilder -> SRules ListBuilder
f SRules ListBuilder
rules)
        a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

runRules :: ShakeOptions -> Rules () -> IO (SRules [])
runRules :: ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts (Rules ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
r) = do
    IORef (SRules ListBuilder)
ref <- SRules ListBuilder -> IO (IORef (SRules ListBuilder))
forall a. a -> IO (IORef a)
newIORef SRules ListBuilder
forall a. Monoid a => a
mempty
    ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
-> (ShakeOptions, IORef (SRules ListBuilder)) -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO ()
r (ShakeOptions
opts, IORef (SRules ListBuilder)
ref)
    SRules{HashMap TypeRep BuiltinRule
ListBuilder String
ListBuilder (Stack, Action ())
ListBuilder Target
Map UserRuleVersioned
helpSuffix :: forall (list :: * -> *). SRules list -> list String
targets :: forall (list :: * -> *). SRules list -> list Target
userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
helpSuffix :: ListBuilder String
targets :: ListBuilder Target
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
actions :: ListBuilder (Stack, Action ())
..} <- IORef (SRules ListBuilder) -> IO (SRules ListBuilder)
forall a. IORef a -> IO a
readIORef IORef (SRules ListBuilder)
ref
    SRules [] -> IO (SRules [])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SRules [] -> IO (SRules [])) -> SRules [] -> IO (SRules [])
forall a b. (a -> b) -> a -> b
$ [(Stack, Action ())]
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> [Target]
-> [String]
-> SRules []
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> SRules list
SRules (ListBuilder (Stack, Action ()) -> [(Stack, Action ())]
forall a. ListBuilder a -> [a]
runListBuilder ListBuilder (Stack, Action ())
actions) HashMap TypeRep BuiltinRule
builtinRules Map UserRuleVersioned
userRules (ListBuilder Target -> [Target]
forall a. ListBuilder a -> [a]
runListBuilder ListBuilder Target
targets) (ListBuilder String -> [String]
forall a. ListBuilder a -> [a]
runListBuilder ListBuilder String
helpSuffix)

-- | Get all targets registered in the given rules. The names in
--   'Development.Shake.phony' and 'Development.Shake.~>' as well as the file patterns
--   in 'Development.Shake.%>', 'Development.Shake.|%>' and 'Development.Shake.&%>' are
--   registered as targets, plus any explicit calls to 'addTarget'.
--   Returns the command, paired with the documentation (if any).
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets ShakeOptions
opts Rules ()
rs = do
    SRules{[Target]
targets :: [Target]
targets :: forall (list :: * -> *). SRules list -> list Target
targets} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
    [(String, Maybe String)] -> IO [(String, Maybe String)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
target, Maybe String
documentation) | Target{String
Maybe String
documentation :: Target -> Maybe String
target :: Target -> String
documentation :: Maybe String
target :: String
..} <- [Target]
targets]

getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix ShakeOptions
opts Rules ()
rs = do
    SRules{[String]
helpSuffix :: [String]
helpSuffix :: forall (list :: * -> *). SRules list -> list String
helpSuffix} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
    [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
helpSuffix

data Target = Target
    {Target -> String
target :: !String
    ,Target -> Maybe String
documentation :: !(Maybe String)
    } deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq,Eq Target
Eq Target
-> (Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmax :: Target -> Target -> Target
>= :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c< :: Target -> Target -> Bool
compare :: Target -> Target -> Ordering
$ccompare :: Target -> Target -> Ordering
$cp1Ord :: Eq Target
Ord,Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show,ReadPrec [Target]
ReadPrec Target
Int -> ReadS Target
ReadS [Target]
(Int -> ReadS Target)
-> ReadS [Target]
-> ReadPrec Target
-> ReadPrec [Target]
-> Read Target
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Target]
$creadListPrec :: ReadPrec [Target]
readPrec :: ReadPrec Target
$creadPrec :: ReadPrec Target
readList :: ReadS [Target]
$creadList :: ReadS [Target]
readsPrec :: Int -> ReadS Target
$creadsPrec :: Int -> ReadS Target
Read,Typeable Target
DataType
Constr
Typeable Target
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Target -> c Target)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Target)
-> (Target -> Constr)
-> (Target -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Target))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target))
-> ((forall b. Data b => b -> b) -> Target -> Target)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Target -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Target -> r)
-> (forall u. (forall d. Data d => d -> u) -> Target -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Target -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Target -> m Target)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Target -> m Target)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Target -> m Target)
-> Data Target
Target -> DataType
Target -> Constr
(forall b. Data b => b -> b) -> Target -> Target
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
forall u. (forall d. Data d => d -> u) -> Target -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Target -> m Target
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Target -> m Target
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Target)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target)
$cTarget :: Constr
$tTarget :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Target -> m Target
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Target -> m Target
gmapMp :: (forall d. Data d => d -> m d) -> Target -> m Target
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Target -> m Target
gmapM :: (forall d. Data d => d -> m d) -> Target -> m Target
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Target -> m Target
gmapQi :: Int -> (forall d. Data d => d -> u) -> Target -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
gmapQ :: (forall d. Data d => d -> u) -> Target -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Target -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
gmapT :: (forall b. Data b => b -> b) -> Target -> Target
$cgmapT :: (forall b. Data b => b -> b) -> Target -> Target
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Target)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Target)
dataTypeOf :: Target -> DataType
$cdataTypeOf :: Target -> DataType
toConstr :: Target -> Constr
$ctoConstr :: Target -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
$cp1Data :: Typeable Target
Data,Typeable)

data SRules list = SRules
    {SRules list -> list (Stack, Action ())
actions :: !(list (Stack, Action ()))
    ,SRules list -> HashMap TypeRep BuiltinRule
builtinRules :: !(Map.HashMap TypeRep{-k-} BuiltinRule)
    ,SRules list -> Map UserRuleVersioned
userRules :: !(TMap.Map UserRuleVersioned)
    ,SRules list -> list Target
targets :: !(list Target)
    ,SRules list -> list String
helpSuffix :: !(list String)
    }

instance Semigroup (SRules ListBuilder) where
    (SRules ListBuilder (Stack, Action ())
x1 HashMap TypeRep BuiltinRule
x2 Map UserRuleVersioned
x3 ListBuilder Target
x4 ListBuilder String
x5) <> :: SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
<> (SRules ListBuilder (Stack, Action ())
y1 HashMap TypeRep BuiltinRule
y2 Map UserRuleVersioned
y3 ListBuilder Target
y4 ListBuilder String
y5) = ListBuilder (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> ListBuilder Target
-> ListBuilder String
-> SRules ListBuilder
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> SRules list
SRules (ListBuilder (Stack, Action ())
-> ListBuilder (Stack, Action ()) -> ListBuilder (Stack, Action ())
forall a. Monoid a => a -> a -> a
mappend ListBuilder (Stack, Action ())
x1 ListBuilder (Stack, Action ())
y1) ((TypeRep -> BuiltinRule -> BuiltinRule -> BuiltinRule)
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep BuiltinRule
forall k v.
(Eq k, Hashable k) =>
(k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
Map.unionWithKey TypeRep -> BuiltinRule -> BuiltinRule -> BuiltinRule
forall a. TypeRep -> BuiltinRule -> BuiltinRule -> a
f HashMap TypeRep BuiltinRule
x2 HashMap TypeRep BuiltinRule
y2) ((forall a.
 UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a)
-> Map UserRuleVersioned
-> Map UserRuleVersioned
-> Map UserRuleVersioned
forall (f :: * -> *).
(forall a. f a -> f a -> f a) -> Map f -> Map f -> Map f
TMap.unionWith forall a. Semigroup a => a -> a -> a
forall a.
UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
(<>) Map UserRuleVersioned
x3 Map UserRuleVersioned
y3) (ListBuilder Target -> ListBuilder Target -> ListBuilder Target
forall a. Monoid a => a -> a -> a
mappend ListBuilder Target
x4 ListBuilder Target
y4) (ListBuilder String -> ListBuilder String -> ListBuilder String
forall a. Monoid a => a -> a -> a
mappend ListBuilder String
x5 ListBuilder String
y5)
        where f :: TypeRep -> BuiltinRule -> BuiltinRule -> a
f TypeRep
k BuiltinRule
a BuiltinRule
b = SomeException -> a
forall a. SomeException -> a
throwImpure (SomeException -> a) -> SomeException -> a
forall a b. (a -> b) -> a -> b
$ TypeRep -> [String] -> SomeException
errorRuleDefinedMultipleTimes TypeRep
k [BuiltinRule -> String
builtinLocation BuiltinRule
a, BuiltinRule -> String
builtinLocation BuiltinRule
b]

instance Monoid (SRules ListBuilder) where
    mempty :: SRules ListBuilder
mempty = ListBuilder (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> ListBuilder Target
-> ListBuilder String
-> SRules ListBuilder
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> SRules list
SRules ListBuilder (Stack, Action ())
forall a. Monoid a => a
mempty HashMap TypeRep BuiltinRule
forall k v. HashMap k v
Map.empty Map UserRuleVersioned
forall (f :: * -> *). Map f
TMap.empty ListBuilder Target
forall a. Monoid a => a
mempty ListBuilder String
forall a. Monoid a => a
mempty
    mappend :: SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
mappend = SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup a => Semigroup (Rules a) where
    <> :: Rules a -> Rules a -> Rules a
(<>) = (a -> a -> a) -> Rules a -> Rules a -> Rules a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup a, Monoid a) => Monoid (Rules a) where
    mempty :: Rules a
mempty = a -> Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    mappend :: Rules a -> Rules a -> Rules a
mappend = Rules a -> Rules a -> Rules a
forall a. Semigroup a => a -> a -> a
(<>)


-- | Add a user rule. In general these should be specialised to the type expected by a builtin rule.
--   The user rules can be retrieved by 'getUserRuleList'.
addUserRule :: Typeable a => a -> Rules ()
addUserRule :: a -> Rules ()
addUserRule a
r = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{userRules :: Map UserRuleVersioned
userRules = UserRuleVersioned a -> Map UserRuleVersioned
forall a (f :: * -> *). Typeable a => f a -> Map f
TMap.singleton (UserRuleVersioned a -> Map UserRuleVersioned)
-> UserRuleVersioned a -> Map UserRuleVersioned
forall a b. (a -> b) -> a -> b
$ Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
False (UserRule a -> UserRuleVersioned a)
-> UserRule a -> UserRuleVersioned a
forall a b. (a -> b) -> a -> b
$ a -> UserRule a
forall a. a -> UserRule a
UserRule a
r}

-- | Register a target, as available when passing @--help@ or through 'getTargets'.
--   Called automatically by rules such as 'Development.Shake.phony' and
--   'Development.Shake.%>' - to avoid that use 'withoutTargets'.
--   To add documentation to a target use 'withTargetDocs'.
addTarget :: String -> Rules ()
addTarget :: String -> Rules ()
addTarget String
t = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{targets :: ListBuilder Target
targets = Target -> ListBuilder Target
forall a. a -> ListBuilder a
newListBuilder (Target -> ListBuilder Target) -> Target -> ListBuilder Target
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Target
Target String
t Maybe String
forall a. Maybe a
Nothing}

-- | For all 'addTarget' targets within the 'Rules' provide the specified documentation, if they
--   don't already have documentation.
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs String
d = (SRules ListBuilder -> SRules ListBuilder) -> Rules () -> Rules ()
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder)
 -> Rules () -> Rules ())
-> (SRules ListBuilder -> SRules ListBuilder)
-> Rules ()
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{targets :: ListBuilder Target
targets = Target -> Target
f (Target -> Target) -> ListBuilder Target -> ListBuilder Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SRules ListBuilder -> ListBuilder Target
forall (list :: * -> *). SRules list -> list Target
targets SRules ListBuilder
x}
    where f :: Target -> Target
f (Target String
a Maybe String
b) = String -> Maybe String -> Target
Target String
a (Maybe String -> Target) -> Maybe String -> Target
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
d Maybe String
b

-- | Remove all targets specified in a set of rules, typically because they are internal details.
--   Overrides 'addTarget'.
withoutTargets :: Rules a -> Rules a
withoutTargets :: Rules a -> Rules a
withoutTargets = (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a)
-> (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{targets :: ListBuilder Target
targets=ListBuilder Target
forall a. Monoid a => a
mempty}

-- | Adds some extra information at the end of @--help@.
addHelpSuffix :: String -> Rules ()
addHelpSuffix :: String -> Rules ()
addHelpSuffix String
s = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{helpSuffix :: ListBuilder String
helpSuffix = String -> ListBuilder String
forall a. a -> ListBuilder a
newListBuilder String
s}

-- | A suitable 'BuiltinLint' that always succeeds.
noLint :: BuiltinLint key value
noLint :: BuiltinLint key value
noLint key
_ value
_ = Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing

-- | A suitable 'BuiltinIdentity' that always fails with a runtime error, incompatible with 'shakeShare'.
--   Use this function if you don't care about 'shakeShare', or if your rule provides a dependency that can
--   never be cached (in which case you should also call 'Development.Shake.historyDisable').
noIdentity :: BuiltinIdentity key value
noIdentity :: BuiltinIdentity key value
noIdentity key
_ value
_ = Maybe ByteString
forall a. Maybe a
Nothing


-- | The type mapping between the @key@ or a rule and the resulting @value@.
--   See 'addBuiltinRule' and 'Development.Shake.Rule.apply'.
type family RuleResult key -- = value

-- | Before looking at this function, you should read the warnings at the top of this module.
--   This function is not often necessary in build systems.
--
--   Define a builtin rule, passing the functions to run in the right circumstances.
--   The @key@ and @value@ types will be what is used by 'Development.Shake.Rule.apply'.
--   As a start, you can use 'noLint' and 'noIdentity' as the first two functions,
--   but are required to supply a suitable 'BuiltinRun'.
--
--   Raises an error if any other rule exists at this type.
--
--   For a worked example of writing a rule see <https://tech-blog.capital-match.com/posts/5-upgrading-shake.html>.
addBuiltinRule
    :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)
    => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule :: BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule = (HasCallStack =>
 BuiltinLint key value
 -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ())
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack =>
  BuiltinLint key value
  -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ())
 -> BuiltinLint key value
 -> BuiltinIdentity key value
 -> BuiltinRun key value
 -> Rules ())
-> (HasCallStack =>
    BuiltinLint key value
    -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ())
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall a b. (a -> b) -> a -> b
$ BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
 NFData value, Show value, HasCallStack) =>
BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
addBuiltinRuleInternal (BinaryOp key
 -> BuiltinLint key value
 -> BuiltinIdentity key value
 -> BuiltinRun key value
 -> Rules ())
-> BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall a b. (a -> b) -> a -> b
$ (key -> Builder) -> (ByteString -> key) -> BinaryOp key
forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp
    (ByteString -> Builder
forall a. BinaryEx a => a -> Builder
putEx (ByteString -> Builder) -> (key -> ByteString) -> key -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Bin.toLazyByteString (Builder -> ByteString) -> (key -> Builder) -> key -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM () -> Builder
forall a. PutM a -> Builder
execPut (PutM () -> Builder) -> (key -> PutM ()) -> key -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> PutM ()
forall t. Binary t => t -> PutM ()
put)
    (Get key -> ByteString -> key
forall a. Get a -> ByteString -> a
runGet Get key
forall t. Binary t => Get t
get (ByteString -> key)
-> (ByteString -> ByteString) -> ByteString -> key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

addBuiltinRuleEx
    :: (RuleResult key ~ value, ShakeValue key, BinaryEx key, Typeable value, NFData value, Show value, Partial)
    => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx :: BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx = BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
 NFData value, Show value, HasCallStack) =>
BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
addBuiltinRuleInternal (BinaryOp key
 -> BuiltinLint key value
 -> BuiltinIdentity key value
 -> BuiltinRun key value
 -> Rules ())
-> BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall a b. (a -> b) -> a -> b
$ (key -> Builder) -> (ByteString -> key) -> BinaryOp key
forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp key -> Builder
forall a. BinaryEx a => a -> Builder
putEx ByteString -> key
forall a. BinaryEx a => ByteString -> a
getEx


-- | Unexpected version of 'addBuiltinRule', which also lets me set the 'BinaryOp'.
addBuiltinRuleInternal
    :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)
    => BinaryOp key -> BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleInternal :: BinaryOp key
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
addBuiltinRuleInternal BinaryOp key
binary BuiltinLint key value
lint BuiltinIdentity key value
check (BuiltinRun key value
run :: BuiltinRun key value) = do
    let k :: Proxy key
k = Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key
    let lint_ :: Key -> Value -> IO (Maybe String)
lint_ Key
k Value
v = BuiltinLint key value
lint (Key -> key
forall a. Typeable a => Key -> a
fromKey Key
k) (Value -> value
forall a. Typeable a => Value -> a
fromValue Value
v)
    let check_ :: Key -> Value -> Maybe ByteString
check_ Key
k Value
v = BuiltinIdentity key value
check (Key -> key
forall a. Typeable a => Key -> a
fromKey Key
k) (Value -> value
forall a. Typeable a => Value -> a
fromValue Value
v)
    let run_ :: Key -> Maybe ByteString -> RunMode -> Action (RunResult Value)
run_ Key
k Maybe ByteString
v RunMode
b = (value -> Value) -> RunResult value -> RunResult Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap value -> Value
forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue (RunResult value -> RunResult Value)
-> Action (RunResult value) -> Action (RunResult Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinRun key value
run (Key -> key
forall a. Typeable a => Key -> a
fromKey Key
k) Maybe ByteString
v RunMode
b
    let binary_ :: BinaryOp Key
binary_ = (Key -> Builder) -> (ByteString -> Key) -> BinaryOp Key
forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp (BinaryOp key -> key -> Builder
forall v. BinaryOp v -> v -> Builder
putOp BinaryOp key
binary (key -> Builder) -> (Key -> key) -> Key -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> key
forall a. Typeable a => Key -> a
fromKey) (key -> Key
forall a. ShakeValue a => a -> Key
newKey (key -> Key) -> (ByteString -> key) -> ByteString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryOp key -> ByteString -> key
forall v. BinaryOp v -> ByteString -> v
getOp BinaryOp key
binary)
    SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{builtinRules :: HashMap TypeRep BuiltinRule
builtinRules = TypeRep -> BuiltinRule -> HashMap TypeRep BuiltinRule
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton (Proxy key -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy key
k) (BuiltinRule -> HashMap TypeRep BuiltinRule)
-> BuiltinRule -> HashMap TypeRep BuiltinRule
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> IO (Maybe String))
-> (Key -> Value -> Maybe ByteString)
-> (Key -> Maybe ByteString -> RunMode -> Action (RunResult Value))
-> BinaryOp Key
-> Ver
-> String
-> BuiltinRule
BuiltinRule Key -> Value -> IO (Maybe String)
lint_ Key -> Value -> Maybe ByteString
check_ Key -> Maybe ByteString -> RunMode -> Action (RunResult Value)
run_ BinaryOp Key
binary_ (Int -> Ver
Ver Int
0) String
HasCallStack => String
callStackTop}


-- | Change the priority of a given set of rules, where higher values take precedence.
--   All matching rules at a given priority must be disjoint, or an error is raised.
--   All builtin Shake rules have priority between 0 and 1.
--   Excessive use of 'priority' is discouraged. As an example:
--
-- @
-- 'priority' 4 $ \"hello.*\" %> \\out -> 'writeFile'' out \"hello.*\"
-- 'priority' 8 $ \"*.txt\" %> \\out -> 'writeFile'' out \"*.txt\"
-- @
--
--   In this example @hello.txt@ will match the second rule, instead of raising an error about ambiguity.
--
--   The 'priority' function obeys the invariants:
--
-- @
-- 'priority' p1 ('priority' p2 r1) === 'priority' p1 r1
-- 'priority' p1 (r1 >> r2) === 'priority' p1 r1 >> 'priority' p1 r2
-- @
priority :: Double -> Rules a -> Rules a
priority :: Seconds -> Rules a -> Rules a
priority Seconds
d = (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a)
-> (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
s -> SRules ListBuilder
s{userRules :: Map UserRuleVersioned
userRules = (forall a. UserRuleVersioned a -> UserRuleVersioned a)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned b x) -> Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
b (UserRule a -> UserRuleVersioned a)
-> UserRule a -> UserRuleVersioned a
forall a b. (a -> b) -> a -> b
$ Seconds -> UserRule a -> UserRule a
forall a. Seconds -> UserRule a -> UserRule a
Priority Seconds
d UserRule a
x) (Map UserRuleVersioned -> Map UserRuleVersioned)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall a b. (a -> b) -> a -> b
$ SRules ListBuilder -> Map UserRuleVersioned
forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
s}


-- | Indicate that the nested rules have a given version. If you change the semantics of the rule then updating (or adding)
--   a version will cause the rule to rebuild in some circumstances.
--
-- @
-- 'versioned' 1 $ \"hello.*\" %> \\out ->
--     'writeFile'' out \"Writes v1 now\" -- previously wrote out v0
-- @
--
--   You should only use 'versioned' to track changes in the build source, for standard runtime dependencies you should use
--   other mechanisms, e.g. 'Development.Shake.addOracle'.
versioned :: Int -> Rules a -> Rules a
versioned :: Int -> Rules a -> Rules a
versioned Int
v = (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a)
-> (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
s -> SRules ListBuilder
s
    {userRules :: Map UserRuleVersioned
userRules = (forall a. UserRuleVersioned a -> UserRuleVersioned a)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned b x) -> Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned (Bool
b Bool -> Bool -> Bool
|| Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (UserRule a -> UserRuleVersioned a)
-> UserRule a -> UserRuleVersioned a
forall a b. (a -> b) -> a -> b
$ Ver -> UserRule a -> UserRule a
forall a. Ver -> UserRule a -> UserRule a
Versioned (Int -> Ver
Ver Int
v) UserRule a
x) (Map UserRuleVersioned -> Map UserRuleVersioned)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall a b. (a -> b) -> a -> b
$ SRules ListBuilder -> Map UserRuleVersioned
forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
s
    ,builtinRules :: HashMap TypeRep BuiltinRule
builtinRules = (BuiltinRule -> BuiltinRule)
-> HashMap TypeRep BuiltinRule -> HashMap TypeRep BuiltinRule
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map (\BuiltinRule
b -> BuiltinRule
b{builtinVersion :: Ver
builtinVersion = Int -> Ver
Ver Int
v}) (HashMap TypeRep BuiltinRule -> HashMap TypeRep BuiltinRule)
-> HashMap TypeRep BuiltinRule -> HashMap TypeRep BuiltinRule
forall a b. (a -> b) -> a -> b
$ SRules ListBuilder -> HashMap TypeRep BuiltinRule
forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
builtinRules SRules ListBuilder
s
    }


-- | Change the matching behaviour of rules so rules do not have to be disjoint, but are instead matched
--   in order. Only recommended for small blocks containing a handful of rules.
--
-- @
-- 'alternatives' $ do
--     \"hello.*\" %> \\out -> 'writeFile'' out \"hello.*\"
--     \"*.txt\" %> \\out -> 'writeFile'' out \"*.txt\"
-- @
--
--   In this example @hello.txt@ will match the first rule, instead of raising an error about ambiguity.
--   Inside 'alternatives' the 'priority' of each rule is not used to determine which rule matches,
--   but the resulting match uses that priority compared to the rules outside the 'alternatives' block.
alternatives :: Rules a -> Rules a
alternatives :: Rules a -> Rules a
alternatives = (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a)
-> (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
r -> SRules ListBuilder
r{userRules :: Map UserRuleVersioned
userRules = (forall a. UserRuleVersioned a -> UserRuleVersioned a)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned b x) -> Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
b (UserRule a -> UserRuleVersioned a)
-> UserRule a -> UserRuleVersioned a
forall a b. (a -> b) -> a -> b
$ UserRule a -> UserRule a
forall a. UserRule a -> UserRule a
Alternative UserRule a
x) (Map UserRuleVersioned -> Map UserRuleVersioned)
-> Map UserRuleVersioned -> Map UserRuleVersioned
forall a b. (a -> b) -> a -> b
$ SRules ListBuilder -> Map UserRuleVersioned
forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
r}


-- | Run an action, usually used for specifying top-level requirements.
--
-- @
-- main = 'Development.Shake.shake' 'shakeOptions' $ do
--    'action' $ do
--        b <- 'Development.Shake.doesFileExist' \"file.src\"
--        when b $ 'Development.Shake.need' [\"file.out\"]
-- @
--
--   This 'action' builds @file.out@, but only if @file.src@ exists. The 'action'
--   will be run in every build execution (unless 'withoutActions' is used), so only cheap
--   operations should be performed. On the flip side, consulting system information
--   (e.g. environment variables) can be done directly as the information will not be cached.
--   All calls to 'action' may be run in parallel, in any order.
--
--   For the standard requirement of only 'Development.Shake.need'ing a fixed list of files in the 'action',
--   see 'Development.Shake.want'.
action :: Partial => Action a -> Rules ()
action :: Action a -> Rules ()
action Action a
act = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{actions :: ListBuilder (Stack, Action ())
actions=(Stack, Action ()) -> ListBuilder (Stack, Action ())
forall a. a -> ListBuilder a
newListBuilder ([String] -> Stack -> Stack
addCallStack [String]
HasCallStack => [String]
callStackFull Stack
emptyStack, Action a -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Action a
act)}


-- | Remove all actions specified in a set of rules, usually used for implementing
--   command line specification of what to build.
withoutActions :: Rules a -> Rules a
withoutActions :: Rules a -> Rules a
withoutActions = (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped ((SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a)
-> (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{actions :: ListBuilder (Stack, Action ())
actions=ListBuilder (Stack, Action ())
forall a. Monoid a => a
mempty}