{-# 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
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
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
key disp :: a -> Maybe String
disp test :: a -> Maybe b
test = do
Global{..} <- 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 versioned :: Bool
versioned rules :: 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 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 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 v :: Int
v,_,x :: 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 v :: Ver
v p :: Maybe Seconds
p (UserRule x :: a
x) = [(Seconds -> Maybe Seconds -> Seconds
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Seconds
p, (Ver
v,a -> Maybe String
disp a
x,b
x2)) | Just x2 :: b
x2 <- [a -> Maybe b
test a
x]]
f v :: Ver
v p :: Maybe Seconds
p (Unordered xs :: [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 v :: Ver
v p :: Maybe Seconds
p (Priority p2 :: Seconds
p2 x :: 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 _ p :: Maybe Seconds
p (Versioned v :: Ver
v x :: UserRule a
x) = Ver
-> Maybe Seconds
-> UserRule a
-> [(Seconds, (Ver, Maybe String, b))]
f Ver
v Maybe Seconds
p UserRule a
x
f v :: Ver
v p :: Maybe Seconds
p (Alternative x :: UserRule a
x) = Int
-> [(Seconds, (Ver, Maybe String, b))]
-> [(Seconds, (Ver, Maybe String, b))]
forall a. Int -> [a] -> [a]
take 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
getUserRuleList :: Typeable a => (a -> Maybe b) -> Action [(Int, b)]
getUserRuleList :: (a -> Maybe b) -> Action [(Int, b)]
getUserRuleList test :: 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
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
key disp :: a -> Maybe String
disp test :: a -> Maybe b
test = do
(_, xs :: [(Int, b)]
xs, err :: 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
[x :: (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
_ -> SomeException -> Action (Maybe (Int, b))
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
err
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
key disp :: a -> Maybe String
disp test :: a -> Maybe b
test = do
(_, xs :: [(Int, b)]
xs, err :: 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
[x :: (Int, b)
x] -> (Int, b) -> Action (Int, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int, b)
x
_ -> SomeException -> Action (Int, b)
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM SomeException
err
newtype Rules a = Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a)
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 x :: 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 f :: SRules ListBuilder -> SRules ListBuilder
f (Rules r :: 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
(opts :: ShakeOptions
opts, refOld :: 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 opts :: ShakeOptions
opts (Rules r :: 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{..} <- 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)
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets opts :: ShakeOptions
opts rs :: 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{..} <- [Target]
targets]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix opts :: ShakeOptions
opts rs :: 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
Constr
DataType
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 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 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 x1 :: ListBuilder (Stack, Action ())
x1 x2 :: HashMap TypeRep BuiltinRule
x2 x3 :: Map UserRuleVersioned
x3 x4 :: ListBuilder Target
x4 x5 :: ListBuilder String
x5) <> :: SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
<> (SRules y1 :: ListBuilder (Stack, Action ())
y1 y2 :: HashMap TypeRep BuiltinRule
y2 y3 :: Map UserRuleVersioned
y3 y4 :: ListBuilder Target
y4 y5 :: 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 k :: TypeRep
k a :: BuiltinRule
a b :: 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
(<>)
addUserRule :: Typeable a => a -> Rules ()
addUserRule :: a -> Rules ()
addUserRule r :: 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}
addTarget :: String -> Rules ()
addTarget :: String -> Rules ()
addTarget t :: 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}
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs d :: 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
$ \x :: 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 a :: String
a b :: 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
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
$ \x :: SRules ListBuilder
x -> SRules ListBuilder
x{targets :: ListBuilder Target
targets=ListBuilder Target
forall a. Monoid a => a
mempty}
addHelpSuffix :: String -> Rules ()
addHelpSuffix :: String -> Rules ()
addHelpSuffix s :: 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}
noLint :: BuiltinLint key value
noLint :: BuiltinLint key value
noLint _ _ = Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
noIdentity :: BuiltinIdentity key value
noIdentity :: BuiltinIdentity key value
noIdentity _ _ = Maybe ByteString
forall a. Maybe a
Nothing
type family RuleResult key
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
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 binary :: BinaryOp key
binary lint :: BuiltinLint key value
lint check :: 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_ k :: Key
k v :: 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_ k :: Key
k v :: 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_ k :: Key
k v :: Maybe ByteString
v b :: 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 0) String
HasCallStack => String
callStackTop}
priority :: Double -> Rules a -> Rules a
priority :: Seconds -> Rules a -> Rules a
priority d :: 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
$ \s :: 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}
versioned :: Int -> Rules a -> Rules a
versioned :: Int -> Rules a -> Rules a
versioned v :: 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
$ \s :: 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
/= 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 (\b :: 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
}
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
$ \r :: 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}
action :: Partial => Action a -> Rules ()
action :: Action a -> Rules ()
action act :: 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)}
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
$ \x :: SRules ListBuilder
x -> SRules ListBuilder
x{actions :: ListBuilder (Stack, Action ())
actions=ListBuilder (Stack, Action ())
forall a. Monoid a => a
mempty}