{-# 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 = forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks 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 :: 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 ()
globalOneShot :: Global -> Bool
globalStep :: Global -> Step
globalCloud :: Global -> Maybe Cloud
globalShared :: Global -> Maybe Shared
globalUserRules :: Global -> Map UserRuleVersioned
globalProgress :: Global -> IO Progress
globalTrackAbsent :: Global -> IORef [(Key, Key)]
globalAfter :: Global -> IORef [IO ()]
globalRuleFinished :: Global -> Key -> Action ()
globalDiagnostic :: Global -> IO String -> IO ()
globalOptions :: Global -> ShakeOptions
globalOutput :: Global -> Verbosity -> String -> IO ()
globalRules :: Global -> HashMap TypeRep BuiltinRule
globalTimestamp :: Global -> IO Double
globalCleanup :: Global -> Cleanup
globalPool :: Global -> Pool
globalDatabase :: Global -> Database
globalBuild :: Global -> [String] -> [Key] -> Action [Value]
globalOneShot :: Bool
globalStep :: Step
globalCloud :: Maybe Cloud
globalShared :: Maybe Shared
globalUserRules :: Map UserRuleVersioned
globalProgress :: IO Progress
globalTrackAbsent :: IORef [(Key, Key)]
globalAfter :: IORef [IO ()]
globalRuleFinished :: Key -> Action ()
globalDiagnostic :: IO String -> IO ()
globalOptions :: ShakeOptions
globalOutput :: Verbosity -> String -> IO ()
globalRules :: HashMap TypeRep BuiltinRule
globalTimestamp :: IO Double
globalCleanup :: Cleanup
globalPool :: Pool
globalDatabase :: Database
globalBuild :: [String] -> [Key] -> Action [Value]
..} <- forall a. RAW ([String], [Key]) [Value] Global Local a -> Action a
Action forall k v ro rw. RAW k v ro rw ro
getRO
let UserRuleVersioned Bool
versioned UserRule a
rules = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). Typeable a => Map f -> Maybe (f a)
TMap.lookup Map UserRuleVersioned
globalUserRules
let ver :: Maybe Ver
ver = if Bool
versioned then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Ver
Ver Int
0
let items :: [(Ver, Maybe String, b)]
items = forall a. a -> [a] -> a
headDef [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> [(k, [v])]
groupSort forall a b. (a -> b) -> a -> b
$ Ver
-> Maybe Double -> UserRule a -> [(Double, (Ver, Maybe String, b))]
f (Int -> Ver
Ver Int
0) forall a. Maybe a
Nothing UserRule a
rules
let err :: SomeException
err = TypeRep -> String -> [Maybe String] -> SomeException
errorMultipleRulesMatch (forall a. Typeable a => a -> TypeRep
typeOf key
key) (forall a. Show a => a -> String
show key
key) (forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> b
snd3 [(Ver, Maybe String, b)]
items)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Ver
ver, 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) = [(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) = 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 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) = forall a. Int -> [a] -> [a]
take Int
1 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
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 = forall a b c. (a, b, c) -> b
snd3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall key a b.
(ShakeValue key, Typeable a) =>
key
-> (a -> Maybe String)
-> (a -> Maybe b)
-> Action (Maybe Ver, [(Int, b)], SomeException)
getUserRuleInternal () (forall a b. a -> b -> a
const 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 :: 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) <- 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
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
[(Int, b)
x] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int, b)
x
[(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 :: 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) <- 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] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int, b)
x
[(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 (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
<$ :: forall a b. a -> Rules b -> Rules a
$c<$ :: forall a b. a -> Rules b -> Rules a
fmap :: forall a b. (a -> b) -> Rules a -> Rules b
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
Functor, Functor 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
<* :: forall a b. Rules a -> Rules b -> Rules a
$c<* :: forall a b. Rules a -> Rules b -> Rules a
*> :: forall a b. Rules a -> Rules b -> Rules b
$c*> :: forall a b. Rules a -> Rules b -> Rules b
liftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
pure :: forall a. a -> Rules a
$cpure :: forall a. a -> Rules a
Applicative, Applicative 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
return :: forall a. a -> Rules a
$creturn :: forall a. a -> Rules a
>> :: forall a b. Rules a -> Rules b -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
Monad, Monad Rules
forall a. IO a -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Rules a
$cliftIO :: forall a. IO a -> Rules a
MonadIO, Monad Rules
forall a. (a -> Rules a) -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> Rules a) -> Rules a
$cmfix :: forall a. (a -> Rules a) -> Rules a
MonadFix, Monad Rules
forall a. String -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Rules a
$cfail :: forall a. String -> Rules a
Control.Monad.Fail.MonadFail)
newRules :: SRules ListBuilder -> Rules ()
newRules :: SRules ListBuilder -> Rules ()
newRules SRules ListBuilder
x = forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (forall a. Semigroup a => a -> a -> a
<> SRules ListBuilder
x) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks 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) = forall a.
ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a -> Rules a
Rules forall a b. (a -> b) -> a -> b
$ do
(ShakeOptions
opts, IORef (SRules ListBuilder)
refOld) <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IORef (SRules ListBuilder)
refNew <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
a
res <- 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 <- forall a. IORef a -> IO a
readIORef IORef (SRules ListBuilder)
refNew
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (SRules ListBuilder)
refOld (forall a. Semigroup a => a -> a -> a
<> SRules ListBuilder -> SRules ListBuilder
f SRules ListBuilder
rules)
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 <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty{allowOverwrite :: Bool
allowOverwrite = ShakeOptions -> Bool
shakeAllowRedefineRules ShakeOptions
opts}
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
helpSuffix :: forall (list :: * -> *). SRules list -> list String
targets :: forall (list :: * -> *). SRules list -> list Target
userRules :: forall (list :: * -> *). SRules list -> Map UserRuleVersioned
builtinRules :: forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
actions :: forall (list :: * -> *). SRules list -> list (Stack, Action ())
allowOverwrite :: Bool
helpSuffix :: ListBuilder String
targets :: ListBuilder Target
userRules :: Map UserRuleVersioned
builtinRules :: HashMap TypeRep BuiltinRule
actions :: ListBuilder (Stack, Action ())
allowOverwrite :: forall (list :: * -> *). SRules list -> Bool
..} <- forall a. IORef a -> IO a
readIORef IORef (SRules ListBuilder)
ref
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> SRules list
SRules (forall a. ListBuilder a -> [a]
runListBuilder ListBuilder (Stack, Action ())
actions) HashMap TypeRep BuiltinRule
builtinRules Map UserRuleVersioned
userRules (forall a. ListBuilder a -> [a]
runListBuilder ListBuilder Target
targets) (forall a. ListBuilder a -> [a]
runListBuilder ListBuilder String
helpSuffix) Bool
allowOverwrite
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]
getTargets ShakeOptions
opts Rules ()
rs = do
SRules{[Target]
targets :: [Target]
targets :: forall (list :: * -> *). SRules list -> list Target
targets} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
target, Maybe String
documentation) | Target{String
Maybe String
documentation :: Target -> Maybe String
target :: Target -> String
documentation :: Maybe String
target :: String
..} <- [Target]
targets]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]
getHelpSuffix ShakeOptions
opts Rules ()
rs = do
SRules{[String]
helpSuffix :: [String]
helpSuffix :: forall (list :: * -> *). SRules list -> list String
helpSuffix} <- ShakeOptions -> Rules () -> IO (SRules [])
runRules ShakeOptions
opts Rules ()
rs
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
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
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
Ord,Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
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]
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
Target -> DataType
Target -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Target -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Target -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Target -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 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) =
forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> SRules list
SRules (forall a. Monoid a => a -> a -> a
mappend ListBuilder (Stack, Action ())
x1 ListBuilder (Stack, Action ())
y1) (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
f HashMap TypeRep BuiltinRule
x2 HashMap TypeRep BuiltinRule
y2) (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
(<>) Map UserRuleVersioned
x3 Map UserRuleVersioned
y3) (forall a. Monoid a => a -> a -> a
mappend ListBuilder Target
x4 ListBuilder Target
y4) (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 = forall a. SomeException -> a
throwImpure 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 = forall (list :: * -> *).
list (Stack, Action ())
-> HashMap TypeRep BuiltinRule
-> Map UserRuleVersioned
-> list Target
-> list String
-> Bool
-> SRules list
SRules forall a. Monoid a => a
mempty forall k v. HashMap k v
Map.empty forall (f :: * -> *). Map f
TMap.empty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Bool
True
mappend :: SRules ListBuilder -> SRules ListBuilder -> SRules ListBuilder
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup a => Semigroup (Rules a) where
<> :: Rules a -> Rules a -> Rules a
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup a, Monoid a) => Monoid (Rules a) where
mempty :: Rules a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mappend :: Rules a -> Rules a -> Rules a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
addUserRule :: Typeable a => a -> Rules ()
addUserRule :: forall a. Typeable a => a -> Rules ()
addUserRule a
r = SRules ListBuilder -> Rules ()
newRules forall a. Monoid a => a
mempty{userRules :: Map UserRuleVersioned
userRules = forall a (f :: * -> *). Typeable a => f a -> Map f
TMap.singleton forall a b. (a -> b) -> a -> b
$ forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> UserRule a
UserRule a
r}
addTarget :: String -> Rules ()
addTarget :: String -> Rules ()
addTarget String
t = SRules ListBuilder -> Rules ()
newRules forall a. Monoid a => a
mempty{targets :: ListBuilder Target
targets = forall a. a -> ListBuilder a
newListBuilder forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Target
Target String
t forall a. Maybe a
Nothing}
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs :: String -> Rules () -> Rules ()
withTargetDocs String
d = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{targets :: ListBuilder Target
targets = Target -> Target
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (list :: * -> *). SRules list -> list Target
targets SRules ListBuilder
x}
where f :: Target -> Target
f (Target String
a Maybe String
b) = String -> Maybe String -> Target
Target String
a forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
d Maybe String
b
withoutTargets :: Rules a -> Rules a
withoutTargets :: forall a. Rules a -> Rules a
withoutTargets = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{targets :: ListBuilder Target
targets=forall a. Monoid a => a
mempty}
addHelpSuffix :: String -> Rules ()
addHelpSuffix :: String -> Rules ()
addHelpSuffix String
s = SRules ListBuilder -> Rules ()
newRules forall a. Monoid a => a
mempty{helpSuffix :: ListBuilder String
helpSuffix = forall a. a -> ListBuilder a
newListBuilder String
s}
noLint :: BuiltinLint key value
noLint :: forall key value. BuiltinLint key value
noLint key
_ value
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
noIdentity :: BuiltinIdentity key value
noIdentity :: forall key value. BuiltinIdentity key value
noIdentity key
_ value
_ = 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 :: 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 = forall a. Partial => (Partial => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp
(forall a. BinaryEx a => a -> Builder
putEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Bin.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PutM a -> Builder
execPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Binary t => t -> Put
put)
(forall a. Get a -> ByteString -> a
runGet forall t. Binary t => Get t
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LBS.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall a b. (a -> b) -> a -> b
$ forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp forall a. BinaryEx a => a -> Builder
putEx 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 :: 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 = 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 (forall a. Typeable a => Key -> a
fromKey Key
k) (forall a. Typeable a => Value -> a
fromValue Value
v)
let check_ :: Key -> Value -> Maybe ByteString
check_ Key
k Value
v = BuiltinIdentity key value
check (forall a. Typeable a => Key -> a
fromKey Key
k) (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Typeable a, Show a, NFData a) => a -> Value
newValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuiltinRun key value
run (forall a. Typeable a => Key -> a
fromKey Key
k) Maybe ByteString
v RunMode
b
let binary_ :: BinaryOp Key
binary_ = forall v. (v -> Builder) -> (ByteString -> v) -> BinaryOp v
BinaryOp (forall v. BinaryOp v -> v -> Builder
putOp BinaryOp key
binary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => Key -> a
fromKey) (forall a. ShakeValue a => a -> Key
newKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. BinaryOp v -> ByteString -> v
getOp BinaryOp key
binary)
SRules ListBuilder -> Rules ()
newRules forall a. Monoid a => a
mempty{builtinRules :: HashMap TypeRep BuiltinRule
builtinRules = forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy key
k) forall a b. (a -> b) -> a -> b
$ (Key -> Value -> IO (Maybe String))
-> (Key -> Value -> Maybe ByteString)
-> (Key -> Maybe ByteString -> RunMode -> Action (RunResult Value))
-> BinaryOp Key
-> Ver
-> String
-> BuiltinRule
BuiltinRule Key -> Value -> IO (Maybe String)
lint_ Key -> Value -> Maybe ByteString
check_ Key -> Maybe ByteString -> RunMode -> Action (RunResult Value)
run_ BinaryOp Key
binary_ (Int -> Ver
Ver Int
0) Partial => String
callStackTop}
priority :: Double -> Rules a -> Rules a
priority :: forall a. Double -> Rules a -> Rules a
priority Double
d = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
s -> SRules ListBuilder
s{userRules :: Map UserRuleVersioned
userRules = forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned Bool
b UserRule a
x) -> forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
b forall a b. (a -> b) -> a -> b
$ forall a. Double -> UserRule a -> UserRule a
Priority Double
d UserRule a
x) forall a b. (a -> b) -> a -> b
$ forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
s}
versioned :: Int -> Rules a -> Rules a
versioned :: forall a. Int -> Rules a -> Rules a
versioned Int
v = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
s -> SRules ListBuilder
s
{userRules :: Map UserRuleVersioned
userRules = forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned Bool
b UserRule a
x) -> forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned (Bool
b Bool -> Bool -> Bool
|| Int
v forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ forall a. Ver -> UserRule a -> UserRule a
Versioned (Int -> Ver
Ver Int
v) UserRule a
x) forall a b. (a -> b) -> a -> b
$ forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
s
,builtinRules :: HashMap TypeRep BuiltinRule
builtinRules = forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map (\BuiltinRule
b -> BuiltinRule
b{builtinVersion :: Ver
builtinVersion = Int -> Ver
Ver Int
v}) forall a b. (a -> b) -> a -> b
$ forall (list :: * -> *). SRules list -> HashMap TypeRep BuiltinRule
builtinRules SRules ListBuilder
s
}
alternatives :: Rules a -> Rules a
alternatives :: forall a. Rules a -> Rules a
alternatives = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
r -> SRules ListBuilder
r{userRules :: Map UserRuleVersioned
userRules = forall (f1 :: * -> *) (f2 :: * -> *).
(forall a. f1 a -> f2 a) -> Map f1 -> Map f2
TMap.map (\(UserRuleVersioned Bool
b UserRule a
x) -> forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
b forall a b. (a -> b) -> a -> b
$ forall a. UserRule a -> UserRule a
Alternative UserRule a
x) forall a b. (a -> b) -> a -> b
$ forall (list :: * -> *). SRules list -> Map UserRuleVersioned
userRules SRules ListBuilder
r}
action :: Partial => Action a -> Rules ()
action :: forall a. Partial => Action a -> Rules ()
action Action a
act = SRules ListBuilder -> Rules ()
newRules forall a. Monoid a => a
mempty{actions :: ListBuilder (Stack, Action ())
actions=forall a. a -> ListBuilder a
newListBuilder ([String] -> Stack -> Stack
addCallStack Partial => [String]
callStackFull Stack
emptyStack, forall (f :: * -> *) a. Functor f => f a -> f ()
void Action a
act)}
withoutActions :: Rules a -> Rules a
withoutActions :: forall a. Rules a -> Rules a
withoutActions = forall a.
(SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a
modifyRulesScoped forall a b. (a -> b) -> a -> b
$ \SRules ListBuilder
x -> SRules ListBuilder
x{actions :: ListBuilder (Stack, Action ())
actions=forall a. Monoid a => a
mempty}