{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds, NamedFieldPuns #-}
{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
{-# LANGUAGE TypeFamilies, TypeOperators, 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 :: 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 = do
    Global{Bool
Maybe Shared
Maybe Cloud
IO Double
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 ()
globalBuild :: [String] -> [Key] -> Action [Value]
globalDatabase :: Database
globalPool :: Pool
globalCleanup :: Cleanup
globalTimestamp :: IO Double
globalRules :: HashMap TypeRep BuiltinRule
globalOutput :: Verbosity -> String -> IO ()
globalOptions :: ShakeOptions
globalDiagnostic :: IO String -> IO ()
globalRuleFinished :: Key -> Action ()
globalAfter :: IORef [IO ()]
globalTrackAbsent :: IORef [(Key, Key)]
globalProgress :: IO Progress
globalUserRules :: Map UserRuleVersioned
globalShared :: Maybe Shared
globalCloud :: Maybe Cloud
globalStep :: Step
globalOneShot :: Bool
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalDatabase :: Global -> Database
globalPool :: Global -> Pool
globalCleanup :: Global -> Cleanup
globalTimestamp :: Global -> IO Double
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalOutput :: Global -> Verbosity -> String -> IO ()
globalOptions :: Global -> ShakeOptions
globalDiagnostic :: Global -> IO String -> IO ()
globalRuleFinished :: Global -> Key -> Action ()
globalAfter :: Global -> IORef [IO ()]
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalProgress :: Global -> IO Progress
globalUserRules :: Global -> Map UserRuleVersioned
globalShared :: Global -> Maybe Shared
globalCloud :: Global -> Maybe Cloud
globalStep :: Global -> Step
globalOneShot :: Global -> Bool
..} <- 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
$ ((Double, [(Ver, Maybe String, b)]) -> [(Ver, Maybe String, b)])
-> [(Double, [(Ver, Maybe String, b)])]
-> [[(Ver, Maybe String, b)]]
forall a b. (a -> b) -> [a] -> [b]
map (Double, [(Ver, Maybe String, b)]) -> [(Ver, Maybe String, b)]
forall a b. (a, b) -> b
snd ([(Double, [(Ver, Maybe String, b)])]
 -> [[(Ver, Maybe String, b)]])
-> [(Double, [(Ver, Maybe String, b)])]
-> [[(Ver, Maybe String, b)]]
forall a b. (a -> b) -> a -> b
$ [(Double, [(Ver, Maybe String, b)])]
-> [(Double, [(Ver, Maybe String, b)])]
forall a. [a] -> [a]
reverse ([(Double, [(Ver, Maybe String, b)])]
 -> [(Double, [(Ver, Maybe String, b)])])
-> [(Double, [(Ver, Maybe String, b)])]
-> [(Double, [(Ver, Maybe String, b)])]
forall a b. (a -> b) -> a -> b
$ [(Double, (Ver, Maybe String, b))]
-> [(Double, [(Ver, Maybe String, b)])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort ([(Double, (Ver, Maybe String, b))]
 -> [(Double, [(Ver, Maybe String, b)])])
-> [(Double, (Ver, Maybe String, b))]
-> [(Double, [(Ver, Maybe String, b)])]
forall a b. (a -> b) -> a -> b
$ Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f (Int -> Ver
Ver Int
0) Maybe Double
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 a. a -> Action a
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 Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f Ver
v Maybe Double
p (UserRule a
x) = [(Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 Maybe Double
p, (Ver
v,a -> Maybe String
disp a
x,b
x2)) | Just b
x2 <- [a -> Maybe b
test a
x]]
        f Ver
v Maybe Double
p (Unordered [UserRule a]
xs) = (UserRule a -> [(Double, (Ver, Maybe String, b))])
-> [UserRule a] -> [(Double, (Ver, Maybe String, b))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f Ver
v Maybe Double
p) [UserRule a]
xs
        f Ver
v Maybe Double
p (Priority Double
p2 UserRule a
x) = Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f Ver
v (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
p2 Maybe Double
p) UserRule a
x
        f Ver
_ Maybe Double
p (Versioned Ver
v UserRule a
x) = Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f Ver
v Maybe Double
p UserRule a
x
        f Ver
v Maybe Double
p (Alternative UserRule a
x) = Int
-> [(Double, (Ver, Maybe String, b))]
-> [(Double, (Ver, Maybe String, b))]
forall a. Int -> [a] -> [a]
take Int
1 ([(Double, (Ver, Maybe String, b))]
 -> [(Double, (Ver, Maybe String, b))])
-> [(Double, (Ver, Maybe String, b))]
-> [(Double, (Ver, Maybe String, b))]
forall a b. (a -> b) -> a -> b
$ Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f Ver
v Maybe Double
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 :: forall a b. Typeable a => (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 :: forall key a b.
(ShakeValue key, Typeable a) =>
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 a. a -> Action a
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 a. a -> Action a
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 :: forall key a b.
(ShakeValue key, Typeable a) =>
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 a. a -> Action a
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 ((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
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
fmap :: forall a b. (a -> b) -> Rules a -> Rules b
$c<$ :: forall a b. a -> Rules b -> Rules a
<$ :: forall a b. a -> Rules b -> Rules a
Functor, Functor Rules
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
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
$cpure :: forall a. a -> Rules a
pure :: forall a. a -> Rules a
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
liftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
$c*> :: forall a b. Rules a -> Rules b -> Rules b
*> :: forall a b. Rules a -> Rules b -> Rules b
$c<* :: forall a b. Rules a -> Rules b -> Rules a
<* :: forall a b. Rules a -> Rules b -> Rules a
Applicative, Applicative Rules
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
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
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>> :: forall a b. Rules a -> Rules b -> Rules b
$creturn :: forall a. a -> Rules a
return :: forall a. a -> Rules a
Monad, Monad Rules
Monad Rules => (forall a. IO a -> Rules a) -> MonadIO Rules
forall a. IO a -> Rules a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Rules a
liftIO :: forall a. IO a -> Rules a
MonadIO, Monad Rules
Monad Rules =>
(forall a. (a -> Rules a) -> Rules a) -> MonadFix Rules
forall a. (a -> Rules a) -> Rules a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall a. (a -> Rules a) -> Rules a
mfix :: forall a. (a -> Rules a) -> Rules a
MonadFix, Monad Rules
Monad Rules => (forall a. String -> Rules a) -> MonadFail Rules
forall a. String -> Rules a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> Rules a
fail :: forall a. String -> Rules a
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 a.
IO a -> ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a
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 :: forall a.
(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 a.
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 a. 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{allowOverwrite = shakeAllowRedefineRules opts}
    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{Bool
HashMap TypeRep BuiltinRule
ListBuilder String
ListBuilder (Stack, Action ())
ListBuilder Target
Map UserRuleVersioned
allowOverwrite :: forall (list :: * -> *). SRules list -> Bool
actions :: ListBuilder (Stack, Action ())
builtinRules :: HashMap TypeRep BuiltinRule
userRules :: Map UserRuleVersioned
targets :: ListBuilder Target
helpSuffix :: ListBuilder String
allowOverwrite :: Bool
actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
targets :: forall (list :: * -> *). SRules list -> list Target
helpSuffix :: forall (list :: * -> *). SRules list -> list String
..} <- IORef (SRules ListBuilder) -> IO (SRules ListBuilder)
forall a. IORef a -> IO a
readIORef IORef (SRules ListBuilder)
ref
    SRules [] -> IO (SRules [])
forall a. a -> IO a
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]
-> Bool
-> SRules []
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> 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) Bool
allowOverwrite

-- | 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 :: forall (list :: * -> *). SRules list -> list Target
targets :: [Target]
targets} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
    [(String, Maybe String)] -> IO [(String, Maybe String)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
target, Maybe String
documentation) | Target{String
Maybe String
target :: String
documentation :: Maybe String
target :: Target -> String
documentation :: Target -> Maybe String
..} <- [Target]
targets]

getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix ShakeOptions
opts Rules ()
rs = do
    SRules{[String]
helpSuffix :: forall (list :: * -> *). SRules list -> list String
helpSuffix :: [String]
helpSuffix} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
    [String] -> IO [String]
forall a. a -> IO a
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
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: 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
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$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
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> 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
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Target
readsPrec :: Int -> ReadS Target
$creadList :: ReadS [Target]
readList :: ReadS [Target]
$creadPrec :: ReadPrec Target
readPrec :: ReadPrec Target
$creadListPrec :: ReadPrec [Target]
readListPrec :: ReadPrec [Target]
Read,Typeable Target
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 -> Constr
Target -> DataType
(forall b. Data b => b -> b) -> Target -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Target -> c Target
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Target
$ctoConstr :: Target -> Constr
toConstr :: Target -> Constr
$cdataTypeOf :: Target -> DataType
dataTypeOf :: Target -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Target)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Target)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Target)
$cgmapT :: (forall b. Data b => b -> b) -> Target -> Target
gmapT :: (forall b. Data b => b -> b) -> Target -> Target
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Target -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Target -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Target -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Target -> m Target
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Target -> m Target
Data,Typeable)

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

instance Semigroup (SRules ListBuilder) where
    (SRules ListBuilder (Stack, Action ())
x1 HashMap TypeRep BuiltinRule
x2 Map UserRuleVersioned
x3 ListBuilder Target
x4 ListBuilder String
x5 Bool
x6) <> :: SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
<> (SRules ListBuilder (Stack, Action ())
y1 HashMap TypeRep BuiltinRule
y2 Map UserRuleVersioned
y3 ListBuilder Target
y4 ListBuilder String
y5 Bool
y6) =
      ListBuilder (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> ListBuilder Target
-> ListBuilder String
-> Bool
-> SRules ListBuilder
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> 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 =>
(k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
Map.unionWithKey TypeRep -> BuiltinRule -> BuiltinRule -> BuiltinRule
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 UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
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) Bool
canOverwrite
      where
        canOverwrite :: Bool
canOverwrite = Bool
x6 Bool -> Bool -> Bool
&& Bool
y6
        f :: TypeRep -> BuiltinRule -> BuiltinRule -> BuiltinRule
f TypeRep
k BuiltinRule
a BuiltinRule
b
          | Bool
canOverwrite = BuiltinRule
b
          | Bool
otherwise = SomeException -> BuiltinRule
forall a. SomeException -> a
throwImpure (SomeException -> BuiltinRule) -> SomeException -> BuiltinRule
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
-> Bool
-> SRules ListBuilder
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> 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 Bool
True
    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 a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
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 a. 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 :: forall a. Typeable a => a -> Rules ()
addUserRule a
r = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{userRules = TMap.singleton $ UserRuleVersioned False $ UserRule 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 = newListBuilder $ Target t 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 = f <$> targets 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 :: forall a. 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=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 = newListBuilder s}

-- | A suitable 'BuiltinLint' that always succeeds.
noLint :: BuiltinLint key value
noLint :: forall key value. BuiltinLint key value
noLint key
_ value
_ = Maybe String -> IO (Maybe String)
forall a. a -> IO a
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 :: forall key value. 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 :: 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 = (Partial =>
 BuiltinLint key value
 -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ())
-> BuiltinLint key value
-> BuiltinIdentity key value
-> BuiltinRun key value
-> Rules ()
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial =>
  BuiltinLint key value
  -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ())
 -> BuiltinLint key value
 -> BuiltinIdentity key value
 -> BuiltinRun key value
 -> Rules ())
-> (Partial =>
    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, 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 ())
-> 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 a. a -> [a]
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 :: forall key value.
(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 = 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, 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 ())
-> 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 :: forall key value.
(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
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 a b. (a -> b) -> RunResult a -> RunResult b
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 = Map.singleton (typeRep k) $ BuiltinRule lint_ check_ run_ binary_ (Ver 0) 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 :: forall a. Double -> Rules a -> Rules a
priority Double
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 = TMap.map (\(UserRuleVersioned Bool
b UserRule a
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
$ Double -> UserRule a -> UserRule a
forall a. Double -> UserRule a -> UserRule a
Priority Double
d UserRule a
x) $ userRules 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 :: forall a. 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 = TMap.map (\(UserRuleVersioned Bool
b UserRule a
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) $ userRules s
    ,builtinRules = Map.map (\BuiltinRule
b -> BuiltinRule
b{builtinVersion = Ver v}) $ builtinRules 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 :: forall a. 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 = TMap.map (\(UserRuleVersioned Bool
b UserRule a
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) $ userRules 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 :: forall a. Partial => Action a -> Rules ()
action Action a
act = SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
forall a. Monoid a => a
mempty{actions=newListBuilder (addCallStack callStackFull emptyStack, void 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 :: forall a. 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=mempty}