{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Development.Shake.Internal.Core.Rules(
Rules, runRules,
RuleResult, addBuiltinRule, addBuiltinRuleEx, noLint,
getShakeOptionsRules, userRuleMatch,
getUserRules, addUserRule, alternatives, priority,
action, withoutActions
) where
import Control.Applicative
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer.Strict
import Development.Shake.Classes
import General.Binary
import Data.Typeable.Extra
import Data.Function
import Data.List.Extra
import qualified Data.HashMap.Strict as Map
import Data.Maybe
import System.IO.Extra
import System.IO.Unsafe
import Data.Semigroup (Semigroup (..))
import Data.Monoid hiding ((<>))
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 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
import Prelude
getUserRules :: Typeable a => Action (UserRule a)
getUserRules :: Action (UserRule a)
getUserRules = Action (UserRule a)
forall a. Typeable a => Action (UserRule a)
f where
f :: forall a . Typeable a => Action (UserRule a)
f :: Action (UserRule a)
f = do
Global{..} <- RAW Global Local Global -> Action Global
forall a. RAW Global Local a -> Action a
Action RAW Global Local Global
forall ro rw. RAW ro rw ro
getRO
UserRule a -> Action (UserRule a)
forall (m :: * -> *) a. Monad m => a -> m a
return (UserRule a -> Action (UserRule a))
-> UserRule a -> Action (UserRule a)
forall a b. (a -> b) -> a -> b
$ case TypeRep -> HashMap TypeRep UserRule_ -> Maybe UserRule_
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) HashMap TypeRep UserRule_
globalUserRules of
Nothing -> [UserRule a] -> UserRule a
forall a. [UserRule a] -> UserRule a
Unordered []
Just (UserRule_ r :: UserRule a
r) -> Maybe (UserRule a) -> UserRule a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (UserRule a) -> UserRule a)
-> Maybe (UserRule a) -> UserRule a
forall a b. (a -> b) -> a -> b
$ UserRule a -> Maybe (UserRule a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast UserRule a
r
getShakeOptionsRules :: Rules ShakeOptions
getShakeOptionsRules :: Rules ShakeOptions
getShakeOptionsRules = WriterT SRules (ReaderT ShakeOptions IO) ShakeOptions
-> Rules ShakeOptions
forall a. WriterT SRules (ReaderT ShakeOptions IO) a -> Rules a
Rules (WriterT SRules (ReaderT ShakeOptions IO) ShakeOptions
-> Rules ShakeOptions)
-> WriterT SRules (ReaderT ShakeOptions IO) ShakeOptions
-> Rules ShakeOptions
forall a b. (a -> b) -> a -> b
$ ReaderT ShakeOptions IO ShakeOptions
-> WriterT SRules (ReaderT ShakeOptions IO) ShakeOptions
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ShakeOptions IO ShakeOptions
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
userRuleMatch :: UserRule a -> (a -> Maybe b) -> [b]
userRuleMatch :: UserRule a -> (a -> Maybe b) -> [b]
userRuleMatch u :: UserRule a
u test :: a -> Maybe b
test = [[b]] -> [b]
forall a. [a] -> a
head ([[b]] -> [b]) -> [[b]] -> [b]
forall a b. (a -> b) -> a -> b
$ (((Seconds, [b]) -> [b]) -> [(Seconds, [b])] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (Seconds, [b]) -> [b]
forall a b. (a, b) -> b
snd ([(Seconds, [b])] -> [[b]]) -> [(Seconds, [b])] -> [[b]]
forall a b. (a -> b) -> a -> b
$ [(Seconds, [b])] -> [(Seconds, [b])]
forall a. [a] -> [a]
reverse ([(Seconds, [b])] -> [(Seconds, [b])])
-> [(Seconds, [b])] -> [(Seconds, [b])]
forall a b. (a -> b) -> a -> b
$ [(Seconds, b)] -> [(Seconds, [b])]
forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort ([(Seconds, b)] -> [(Seconds, [b])])
-> [(Seconds, b)] -> [(Seconds, [b])]
forall a b. (a -> b) -> a -> b
$ Maybe Seconds -> UserRule (Maybe b) -> [(Seconds, b)]
forall a. Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
f Maybe Seconds
forall a. Maybe a
Nothing (UserRule (Maybe b) -> [(Seconds, b)])
-> UserRule (Maybe b) -> [(Seconds, b)]
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> UserRule a -> UserRule (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
test UserRule a
u) [[b]] -> [[b]] -> [[b]]
forall a. [a] -> [a] -> [a]
++ [[]]
where
f :: Maybe Double -> UserRule (Maybe a) -> [(Double,a)]
f :: Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
f p :: Maybe Seconds
p (UserRule x :: Maybe a
x) = [(Seconds, a)]
-> (a -> [(Seconds, a)]) -> Maybe a -> [(Seconds, a)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\x :: a
x -> [(Seconds -> Maybe Seconds -> Seconds
forall a. a -> Maybe a -> a
fromMaybe 1 Maybe Seconds
p,a
x)]) Maybe a
x
f p :: Maybe Seconds
p (Unordered xs :: [UserRule (Maybe a)]
xs) = (UserRule (Maybe a) -> [(Seconds, a)])
-> [UserRule (Maybe a)] -> [(Seconds, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
forall a. Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
f Maybe Seconds
p) [UserRule (Maybe a)]
xs
f p :: Maybe Seconds
p (Priority p2 :: Seconds
p2 x :: UserRule (Maybe a)
x) = Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
forall a. Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
f (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 (Maybe a)
x
f p :: Maybe Seconds
p (Alternative x :: UserRule (Maybe a)
x) = case Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
forall a. Maybe Seconds -> UserRule (Maybe a) -> [(Seconds, a)]
f Maybe Seconds
p UserRule (Maybe a)
x of
[] -> []
xs :: [(Seconds, a)]
xs -> [([Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Seconds] -> Seconds) -> [Seconds] -> Seconds
forall a b. (a -> b) -> a -> b
$ ((Seconds, a) -> Seconds) -> [(Seconds, a)] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map (Seconds, a) -> Seconds
forall a b. (a, b) -> a
fst [(Seconds, a)]
xs, (Seconds, a) -> a
forall a b. (a, b) -> b
snd ((Seconds, a) -> a) -> (Seconds, a) -> a
forall a b. (a -> b) -> a -> b
$ [(Seconds, a)] -> (Seconds, a)
forall a. [a] -> a
head [(Seconds, a)]
xs)]
newtype Rules a = Rules (WriterT SRules (ReaderT ShakeOptions 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)
newRules :: SRules -> Rules ()
newRules :: SRules -> Rules ()
newRules = WriterT SRules (ReaderT ShakeOptions IO) () -> Rules ()
forall a. WriterT SRules (ReaderT ShakeOptions IO) a -> Rules a
Rules (WriterT SRules (ReaderT ShakeOptions IO) () -> Rules ())
-> (SRules -> WriterT SRules (ReaderT ShakeOptions IO) ())
-> SRules
-> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRules -> WriterT SRules (ReaderT ShakeOptions IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
modifyRules :: (SRules -> SRules) -> Rules () -> Rules ()
modifyRules :: (SRules -> SRules) -> Rules () -> Rules ()
modifyRules f :: SRules -> SRules
f (Rules r :: WriterT SRules (ReaderT ShakeOptions IO) ()
r) = WriterT SRules (ReaderT ShakeOptions IO) () -> Rules ()
forall a. WriterT SRules (ReaderT ShakeOptions IO) a -> Rules a
Rules (WriterT SRules (ReaderT ShakeOptions IO) () -> Rules ())
-> WriterT SRules (ReaderT ShakeOptions IO) () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (SRules -> SRules)
-> WriterT SRules (ReaderT ShakeOptions IO) ()
-> WriterT SRules (ReaderT ShakeOptions IO) ()
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
censor SRules -> SRules
f WriterT SRules (ReaderT ShakeOptions IO) ()
r
runRules :: ShakeOptions -> Rules () -> IO ([Action ()], Map.HashMap TypeRep BuiltinRule, Map.HashMap TypeRep UserRule_)
runRules :: ShakeOptions
-> Rules ()
-> IO
([Action ()], HashMap TypeRep BuiltinRule,
HashMap TypeRep UserRule_)
runRules opts :: ShakeOptions
opts (Rules r :: WriterT SRules (ReaderT ShakeOptions IO) ()
r) = do
SRules{..} <- ReaderT ShakeOptions IO SRules -> ShakeOptions -> IO SRules
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT SRules (ReaderT ShakeOptions IO) ()
-> ReaderT ShakeOptions IO SRules
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT WriterT SRules (ReaderT ShakeOptions IO) ()
r) ShakeOptions
opts
([Action ()], HashMap TypeRep BuiltinRule,
HashMap TypeRep UserRule_)
-> IO
([Action ()], HashMap TypeRep BuiltinRule,
HashMap TypeRep UserRule_)
forall (m :: * -> *) a. Monad m => a -> m a
return (ListBuilder (Action ()) -> [Action ()]
forall a. ListBuilder a -> [a]
runListBuilder ListBuilder (Action ())
actions, HashMap TypeRep BuiltinRule
builtinRules, HashMap TypeRep UserRule_
userRules)
data SRules = SRules
{SRules -> ListBuilder (Action ())
actions :: !(ListBuilder (Action ()))
,SRules -> HashMap TypeRep BuiltinRule
builtinRules :: !(Map.HashMap TypeRep BuiltinRule)
,SRules -> HashMap TypeRep UserRule_
userRules :: !(Map.HashMap TypeRep UserRule_)
}
instance Semigroup SRules where
(SRules x1 :: ListBuilder (Action ())
x1 x2 :: HashMap TypeRep BuiltinRule
x2 x3 :: HashMap TypeRep UserRule_
x3) <> :: SRules -> SRules -> SRules
<> (SRules y1 :: ListBuilder (Action ())
y1 y2 :: HashMap TypeRep BuiltinRule
y2 y3 :: HashMap TypeRep UserRule_
y3) = ListBuilder (Action ())
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep UserRule_
-> SRules
SRules (ListBuilder (Action ())
-> ListBuilder (Action ()) -> ListBuilder (Action ())
forall a. Monoid a => a -> a -> a
mappend ListBuilder (Action ())
x1 ListBuilder (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 p p a. TypeRep -> p -> p -> a
f HashMap TypeRep BuiltinRule
x2 HashMap TypeRep BuiltinRule
y2) ((UserRule_ -> UserRule_ -> UserRule_)
-> HashMap TypeRep UserRule_
-> HashMap TypeRep UserRule_
-> HashMap TypeRep UserRule_
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
Map.unionWith UserRule_ -> UserRule_ -> UserRule_
g HashMap TypeRep UserRule_
x3 HashMap TypeRep UserRule_
y3)
where
f :: TypeRep -> p -> p -> a
f k :: TypeRep
k _ _ = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ TypeRep -> IO a
forall a. TypeRep -> IO a
errorRuleDefinedMultipleTimes TypeRep
k
g :: UserRule_ -> UserRule_ -> UserRule_
g (UserRule_ x :: UserRule a
x) (UserRule_ y) = UserRule a -> UserRule_
forall a. Typeable a => UserRule a -> UserRule_
UserRule_ (UserRule a -> UserRule_) -> UserRule a -> UserRule_
forall a b. (a -> b) -> a -> b
$ [UserRule a] -> UserRule a
forall a. [UserRule a] -> UserRule a
Unordered ([UserRule a] -> UserRule a) -> [UserRule a] -> UserRule a
forall a b. (a -> b) -> a -> b
$ UserRule a -> [UserRule a]
forall a. UserRule a -> [UserRule a]
fromUnordered UserRule a
x [UserRule a] -> [UserRule a] -> [UserRule a]
forall a. [a] -> [a] -> [a]
++ UserRule a -> [UserRule a]
forall a. UserRule a -> [UserRule a]
fromUnordered (Maybe (UserRule a) -> UserRule a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (UserRule a) -> UserRule a)
-> Maybe (UserRule a) -> UserRule a
forall a b. (a -> b) -> a -> b
$ UserRule a -> Maybe (UserRule a)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast UserRule a
y)
fromUnordered :: UserRule a -> [UserRule a]
fromUnordered (Unordered xs :: [UserRule a]
xs) = [UserRule a]
xs
fromUnordered x :: UserRule a
x = [UserRule a
x]
instance Monoid SRules where
mempty :: SRules
mempty = ListBuilder (Action ())
-> HashMap TypeRep BuiltinRule
-> HashMap TypeRep UserRule_
-> SRules
SRules ListBuilder (Action ())
forall a. Monoid a => a
mempty HashMap TypeRep BuiltinRule
forall k v. HashMap k v
Map.empty HashMap TypeRep UserRule_
forall k v. HashMap k v
Map.empty
mappend :: SRules -> SRules -> SRules
mappend = SRules -> SRules -> SRules
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 (m :: * -> *) a. Monad m => a -> m a
return 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 -> Rules ()
newRules SRules
forall a. Monoid a => a
mempty{userRules :: HashMap TypeRep UserRule_
userRules = TypeRep -> UserRule_ -> HashMap TypeRep UserRule_
forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
r) (UserRule_ -> HashMap TypeRep UserRule_)
-> UserRule_ -> HashMap TypeRep UserRule_
forall a b. (a -> b) -> a -> b
$ UserRule a -> UserRule_
forall a. Typeable a => UserRule a -> UserRule_
UserRule_ (UserRule a -> UserRule_) -> UserRule a -> UserRule_
forall a b. (a -> b) -> a -> b
$ a -> UserRule a
forall a. a -> UserRule a
UserRule a
r}
noLint :: BuiltinLint key value
noLint :: BuiltinLint key value
noLint _ _ = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
type family RuleResult key
addBuiltinRule :: (RuleResult key ~ value, ShakeValue key, ShakeValue value) => BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRule :: BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRule = BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
NFData value, Show value) =>
BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleInternal (BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ())
-> BinaryOp key
-> BuiltinLint 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 (m :: * -> *) a. Monad m => a -> m a
return)
addBuiltinRuleEx :: (RuleResult key ~ value, ShakeValue key, BinaryEx key, Typeable value, NFData value, Show value) => BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx :: BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleEx = BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
NFData value, Show value) =>
BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleInternal (BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ())
-> BinaryOp key
-> BuiltinLint 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) => BinaryOp key -> BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleInternal :: BinaryOp key
-> BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRuleInternal binary :: BinaryOp key
binary lint :: BuiltinLint key value
lint (BuiltinRun key value
run :: BuiltinRun key value) = do
let k :: Proxy key
k = Proxy key
forall k (t :: k). Proxy t
Proxy :: Proxy key
v :: Proxy value
v = Proxy value
forall k (t :: k). Proxy t
Proxy :: Proxy value
let run_ :: Key -> Maybe ByteString -> Bool -> Action (RunResult Value)
run_ k :: Key
k v :: Maybe ByteString
v b :: Bool
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 Bool
b
let lint_ :: Key -> Value -> IO (Maybe FilePath)
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 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 -> Rules ()
newRules SRules
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 -> Maybe ByteString -> Bool -> Action (RunResult Value))
-> (Key -> Value -> IO (Maybe FilePath))
-> TypeRep
-> BinaryOp Key
-> BuiltinRule
BuiltinRule Key -> Maybe ByteString -> Bool -> Action (RunResult Value)
run_ Key -> Value -> IO (Maybe FilePath)
lint_ (Proxy value -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy value
v) BinaryOp Key
binary_}
priority :: Double -> Rules () -> Rules ()
priority :: Seconds -> Rules () -> Rules ()
priority d :: Seconds
d = (SRules -> SRules) -> Rules () -> Rules ()
modifyRules ((SRules -> SRules) -> Rules () -> Rules ())
-> (SRules -> SRules) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ \s :: SRules
s -> SRules
s{userRules :: HashMap TypeRep UserRule_
userRules = (UserRule_ -> UserRule_)
-> HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map UserRule_ -> UserRule_
f (HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_)
-> HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_
forall a b. (a -> b) -> a -> b
$ SRules -> HashMap TypeRep UserRule_
userRules SRules
s}
where f :: UserRule_ -> UserRule_
f (UserRule_ s :: UserRule a
s) = UserRule a -> UserRule_
forall a. Typeable a => UserRule a -> UserRule_
UserRule_ (UserRule a -> UserRule_) -> UserRule a -> UserRule_
forall a b. (a -> b) -> a -> b
$ Seconds -> UserRule a -> UserRule a
forall a. Seconds -> UserRule a -> UserRule a
Priority Seconds
d UserRule a
s
alternatives :: Rules () -> Rules ()
alternatives :: Rules () -> Rules ()
alternatives = (SRules -> SRules) -> Rules () -> Rules ()
modifyRules ((SRules -> SRules) -> Rules () -> Rules ())
-> (SRules -> SRules) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ \r :: SRules
r -> SRules
r{userRules :: HashMap TypeRep UserRule_
userRules = (UserRule_ -> UserRule_)
-> HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map UserRule_ -> UserRule_
f (HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_)
-> HashMap TypeRep UserRule_ -> HashMap TypeRep UserRule_
forall a b. (a -> b) -> a -> b
$ SRules -> HashMap TypeRep UserRule_
userRules SRules
r}
where f :: UserRule_ -> UserRule_
f (UserRule_ s :: UserRule a
s) = UserRule a -> UserRule_
forall a. Typeable a => UserRule a -> UserRule_
UserRule_ (UserRule a -> UserRule_) -> UserRule a -> UserRule_
forall a b. (a -> b) -> a -> b
$ UserRule a -> UserRule a
forall a. UserRule a -> UserRule a
Alternative UserRule a
s
action :: Action a -> Rules ()
action :: Action a -> Rules ()
action a :: Action a
a = SRules -> Rules ()
newRules SRules
forall a. Monoid a => a
mempty{actions :: ListBuilder (Action ())
actions=Action () -> ListBuilder (Action ())
forall a. a -> ListBuilder a
newListBuilder (Action () -> ListBuilder (Action ()))
-> Action () -> ListBuilder (Action ())
forall a b. (a -> b) -> a -> b
$ Action a -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Action a
a}
withoutActions :: Rules () -> Rules ()
withoutActions :: Rules () -> Rules ()
withoutActions = (SRules -> SRules) -> Rules () -> Rules ()
modifyRules ((SRules -> SRules) -> Rules () -> Rules ())
-> (SRules -> SRules) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ \x :: SRules
x -> SRules
x{actions :: ListBuilder (Action ())
actions=ListBuilder (Action ())
forall a. Monoid a => a
mempty}