{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
module Development.Shake.Internal.Rules.Oracle(
addOracle, addOracleCache, addOracleHash,
askOracle, askOracles
) where
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Options
import Development.Shake.Internal.Core.Build
import Development.Shake.Internal.Value
import Development.Shake.Classes
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Control.Monad
import Data.Binary
import General.Binary
import General.Extra
newtype OracleQ question = OracleQ question
deriving (Int -> OracleQ question -> ShowS
[OracleQ question] -> ShowS
OracleQ question -> String
(Int -> OracleQ question -> ShowS)
-> (OracleQ question -> String)
-> ([OracleQ question] -> ShowS)
-> Show (OracleQ question)
forall question. Show question => Int -> OracleQ question -> ShowS
forall question. Show question => [OracleQ question] -> ShowS
forall question. Show question => OracleQ question -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OracleQ question] -> ShowS
$cshowList :: forall question. Show question => [OracleQ question] -> ShowS
show :: OracleQ question -> String
$cshow :: forall question. Show question => OracleQ question -> String
showsPrec :: Int -> OracleQ question -> ShowS
$cshowsPrec :: forall question. Show question => Int -> OracleQ question -> ShowS
Show,Typeable,OracleQ question -> OracleQ question -> Bool
(OracleQ question -> OracleQ question -> Bool)
-> (OracleQ question -> OracleQ question -> Bool)
-> Eq (OracleQ question)
forall question.
Eq question =>
OracleQ question -> OracleQ question -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OracleQ question -> OracleQ question -> Bool
$c/= :: forall question.
Eq question =>
OracleQ question -> OracleQ question -> Bool
== :: OracleQ question -> OracleQ question -> Bool
$c== :: forall question.
Eq question =>
OracleQ question -> OracleQ question -> Bool
Eq,Int -> OracleQ question -> Int
OracleQ question -> Int
(Int -> OracleQ question -> Int)
-> (OracleQ question -> Int) -> Hashable (OracleQ question)
forall question.
Hashable question =>
Int -> OracleQ question -> Int
forall question. Hashable question => OracleQ question -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OracleQ question -> Int
$chash :: forall question. Hashable question => OracleQ question -> Int
hashWithSalt :: Int -> OracleQ question -> Int
$chashWithSalt :: forall question.
Hashable question =>
Int -> OracleQ question -> Int
Hashable,Get (OracleQ question)
[OracleQ question] -> Put
OracleQ question -> Put
(OracleQ question -> Put)
-> Get (OracleQ question)
-> ([OracleQ question] -> Put)
-> Binary (OracleQ question)
forall question. Binary question => Get (OracleQ question)
forall question. Binary question => [OracleQ question] -> Put
forall question. Binary question => OracleQ question -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [OracleQ question] -> Put
$cputList :: forall question. Binary question => [OracleQ question] -> Put
get :: Get (OracleQ question)
$cget :: forall question. Binary question => Get (OracleQ question)
put :: OracleQ question -> Put
$cput :: forall question. Binary question => OracleQ question -> Put
Binary,OracleQ question -> ()
(OracleQ question -> ()) -> NFData (OracleQ question)
forall question. NFData question => OracleQ question -> ()
forall a. (a -> ()) -> NFData a
rnf :: OracleQ question -> ()
$crnf :: forall question. NFData question => OracleQ question -> ()
NFData)
newtype OracleA answer = OracleA answer
deriving (Int -> OracleA answer -> ShowS
[OracleA answer] -> ShowS
OracleA answer -> String
(Int -> OracleA answer -> ShowS)
-> (OracleA answer -> String)
-> ([OracleA answer] -> ShowS)
-> Show (OracleA answer)
forall answer. Show answer => Int -> OracleA answer -> ShowS
forall answer. Show answer => [OracleA answer] -> ShowS
forall answer. Show answer => OracleA answer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OracleA answer] -> ShowS
$cshowList :: forall answer. Show answer => [OracleA answer] -> ShowS
show :: OracleA answer -> String
$cshow :: forall answer. Show answer => OracleA answer -> String
showsPrec :: Int -> OracleA answer -> ShowS
$cshowsPrec :: forall answer. Show answer => Int -> OracleA answer -> ShowS
Show,Typeable,OracleA answer -> OracleA answer -> Bool
(OracleA answer -> OracleA answer -> Bool)
-> (OracleA answer -> OracleA answer -> Bool)
-> Eq (OracleA answer)
forall answer.
Eq answer =>
OracleA answer -> OracleA answer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OracleA answer -> OracleA answer -> Bool
$c/= :: forall answer.
Eq answer =>
OracleA answer -> OracleA answer -> Bool
== :: OracleA answer -> OracleA answer -> Bool
$c== :: forall answer.
Eq answer =>
OracleA answer -> OracleA answer -> Bool
Eq,Int -> OracleA answer -> Int
OracleA answer -> Int
(Int -> OracleA answer -> Int)
-> (OracleA answer -> Int) -> Hashable (OracleA answer)
forall answer. Hashable answer => Int -> OracleA answer -> Int
forall answer. Hashable answer => OracleA answer -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OracleA answer -> Int
$chash :: forall answer. Hashable answer => OracleA answer -> Int
hashWithSalt :: Int -> OracleA answer -> Int
$chashWithSalt :: forall answer. Hashable answer => Int -> OracleA answer -> Int
Hashable,Get (OracleA answer)
[OracleA answer] -> Put
OracleA answer -> Put
(OracleA answer -> Put)
-> Get (OracleA answer)
-> ([OracleA answer] -> Put)
-> Binary (OracleA answer)
forall answer. Binary answer => Get (OracleA answer)
forall answer. Binary answer => [OracleA answer] -> Put
forall answer. Binary answer => OracleA answer -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [OracleA answer] -> Put
$cputList :: forall answer. Binary answer => [OracleA answer] -> Put
get :: Get (OracleA answer)
$cget :: forall answer. Binary answer => Get (OracleA answer)
put :: OracleA answer -> Put
$cput :: forall answer. Binary answer => OracleA answer -> Put
Binary,OracleA answer -> ()
(OracleA answer -> ()) -> NFData (OracleA answer)
forall answer. NFData answer => OracleA answer -> ()
forall a. (a -> ()) -> NFData a
rnf :: OracleA answer -> ()
$crnf :: forall answer. NFData answer => OracleA answer -> ()
NFData)
fromOracleA :: OracleA a -> a
fromOracleA :: OracleA a -> a
fromOracleA (OracleA a
x) = a
x
type instance RuleResult (OracleQ a) = OracleA (RuleResult a)
data Flavor = Norm | Cache | Hash deriving Flavor -> Flavor -> Bool
(Flavor -> Flavor -> Bool)
-> (Flavor -> Flavor -> Bool) -> Eq Flavor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flavor -> Flavor -> Bool
$c/= :: Flavor -> Flavor -> Bool
== :: Flavor -> Flavor -> Bool
$c== :: Flavor -> Flavor -> Bool
Eq
addOracleFlavor :: (Located, RuleResult q ~ a, ShakeValue q, ShakeValue a) => Flavor -> (q -> Action a) -> Rules (q -> Action a)
addOracleFlavor :: Flavor -> (q -> Action a) -> Rules (q -> Action a)
addOracleFlavor Flavor
flavor q -> Action a
act = do
ShakeOptions
opts <- Rules ShakeOptions
getShakeOptionsRules
let skip :: Bool
skip = ShakeOptions -> String -> Rebuild
shakeRebuildApply ShakeOptions
opts String
"" Rebuild -> Rebuild -> Bool
forall a. Eq a => a -> a -> Bool
== Rebuild
RebuildLater
BuiltinLint (OracleQ q) (OracleA a)
-> BuiltinIdentity (OracleQ q) (OracleA a)
-> BuiltinRun (OracleQ q) (OracleA a)
-> Rules ()
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 BuiltinLint (OracleQ q) (OracleA a)
forall key value. BuiltinLint key value
noLint (\OracleQ q
_ OracleA a
v -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ OracleA a -> Int
forall a. Hashable a => a -> Int
hash OracleA a
v) (BuiltinRun (OracleQ q) (OracleA a) -> Rules ())
-> BuiltinRun (OracleQ q) (OracleA a) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(OracleQ q
q) Maybe ByteString
old RunMode
mode -> case Maybe ByteString
old of
Just ByteString
old | (Flavor
flavor Flavor -> Flavor -> Bool
forall a. Eq a => a -> a -> Bool
/= Flavor
Hash Bool -> Bool -> Bool
&& Bool
skip) Bool -> Bool -> Bool
|| (Flavor
flavor Flavor -> Flavor -> Bool
forall a. Eq a => a -> a -> Bool
== Flavor
Cache Bool -> Bool -> Bool
&& RunMode
mode RunMode -> RunMode -> Bool
forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame) ->
RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult (OracleA a) -> Action (RunResult (OracleA a)))
-> RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> OracleA a -> RunResult (OracleA a)
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
old (OracleA a -> RunResult (OracleA a))
-> OracleA a -> RunResult (OracleA a)
forall a b. (a -> b) -> a -> b
$ ByteString -> OracleA a
forall a. Binary a => ByteString -> a
decode' ByteString
old
Maybe ByteString
_ -> do
let cmpValue :: OracleA a -> RunChanged
cmpValue OracleA a
new = if (ByteString -> OracleA a) -> Maybe ByteString -> Maybe (OracleA a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> OracleA a
forall a. Binary a => ByteString -> a
decode' Maybe ByteString
old Maybe (OracleA a) -> Maybe (OracleA a) -> Bool
forall a. Eq a => a -> a -> Bool
== OracleA a -> Maybe (OracleA a)
forall a. a -> Maybe a
Just OracleA a
new then RunChanged
ChangedRecomputeSame else RunChanged
ChangedRecomputeDiff
let cmpHash :: ByteString -> RunChanged
cmpHash ByteString
newHash = if Maybe ByteString
old Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
newHash then RunChanged
ChangedRecomputeSame else RunChanged
ChangedRecomputeDiff
Maybe ByteString
cache <- if Flavor
flavor Flavor -> Flavor -> Bool
forall a. Eq a => a -> a -> Bool
== Flavor
Cache then Int -> Action (Maybe ByteString)
historyLoad Int
0 else Maybe ByteString -> Action (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
case Maybe ByteString
cache of
Just ByteString
newEncode -> do
let new :: OracleA a
new = ByteString -> OracleA a
forall a. Binary a => ByteString -> a
decode' ByteString
newEncode
RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult (OracleA a) -> Action (RunResult (OracleA a)))
-> RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> OracleA a -> RunResult (OracleA a)
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult (OracleA a -> RunChanged
cmpValue OracleA a
new) ByteString
newEncode OracleA a
new
Maybe ByteString
Nothing -> do
OracleA a
new <- a -> OracleA a
forall answer. answer -> OracleA answer
OracleA (a -> OracleA a) -> Action a -> Action (OracleA a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> q -> Action a
act q
q
let newHash :: ByteString
newHash = OracleA a -> ByteString
forall a. Hashable a => a -> ByteString
encodeHash OracleA a
new
let newEncode :: ByteString
newEncode = OracleA a -> ByteString
forall a. Binary a => a -> ByteString
encode' OracleA a
new
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flavor
flavor Flavor -> Flavor -> Bool
forall a. Eq a => a -> a -> Bool
== Flavor
Cache) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
Int -> ByteString -> Action ()
historySave Int
0 ByteString
newEncode
RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult (OracleA a) -> Action (RunResult (OracleA a)))
-> RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall a b. (a -> b) -> a -> b
$
if Flavor
flavor Flavor -> Flavor -> Bool
forall a. Eq a => a -> a -> Bool
== Flavor
Hash
then RunChanged -> ByteString -> OracleA a -> RunResult (OracleA a)
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult (ByteString -> RunChanged
cmpHash ByteString
newHash) ByteString
newHash OracleA a
new
else RunChanged -> ByteString -> OracleA a -> RunResult (OracleA a)
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult (OracleA a -> RunChanged
cmpValue OracleA a
new) ByteString
newEncode OracleA a
new
(q -> Action a) -> Rules (q -> Action a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure q -> Action a
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle
where
encodeHash :: Hashable a => a -> BS.ByteString
encodeHash :: a -> ByteString
encodeHash = Builder -> ByteString
runBuilder (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. BinaryEx a => a -> Builder
putEx (Int -> Builder) -> (a -> Int) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Hashable a => a -> Int
hash
encode' :: Binary a => a -> BS.ByteString
encode' :: a -> ByteString
encode' = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks (ByteString -> [ByteString])
-> (a -> ByteString) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Binary a => a -> ByteString
encode
decode' :: Binary a => BS.ByteString -> a
decode' :: ByteString -> a
decode' = ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
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
addOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)
addOracle :: (q -> Action a) -> Rules (q -> Action a)
addOracle = (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a)
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a))
-> (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a)
-> Rules (q -> Action a)
forall a b. (a -> b) -> a -> b
$ Flavor -> (q -> Action a) -> Rules (q -> Action a)
forall q a.
(Partial, RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
Flavor -> (q -> Action a) -> Rules (q -> Action a)
addOracleFlavor Flavor
Norm
addOracleHash :: (RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)
addOracleHash :: (q -> Action a) -> Rules (q -> Action a)
addOracleHash = (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a)
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a))
-> (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a)
-> Rules (q -> Action a)
forall a b. (a -> b) -> a -> b
$ Flavor -> (q -> Action a) -> Rules (q -> Action a)
forall q a.
(Partial, RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
Flavor -> (q -> Action a) -> Rules (q -> Action a)
addOracleFlavor Flavor
Hash
addOracleCache ::(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)
addOracleCache :: (q -> Action a) -> Rules (q -> Action a)
addOracleCache = (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a)
forall a. Partial => (Partial => a) -> a
withFrozenCallStack ((Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a) -> Rules (q -> Action a))
-> (Partial => (q -> Action a) -> Rules (q -> Action a))
-> (q -> Action a)
-> Rules (q -> Action a)
forall a b. (a -> b) -> a -> b
$ Flavor -> (q -> Action a) -> Rules (q -> Action a)
forall q a.
(Partial, RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
Flavor -> (q -> Action a) -> Rules (q -> Action a)
addOracleFlavor Flavor
Cache
askOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => q -> Action a
askOracle :: q -> Action a
askOracle = (OracleA a -> a) -> Action (OracleA a) -> Action a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OracleA a -> a
forall a. OracleA a -> a
fromOracleA (Action (OracleA a) -> Action a)
-> (q -> Action (OracleA a)) -> q -> Action a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OracleQ q -> Action (OracleA a)
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
Typeable value) =>
key -> Action value
apply1 (OracleQ q -> Action (OracleA a))
-> (q -> OracleQ q) -> q -> Action (OracleA a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> OracleQ q
forall question. question -> OracleQ question
OracleQ
askOracles :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => [q] -> Action [a]
askOracles :: [q] -> Action [a]
askOracles = ([OracleA a] -> [a]) -> Action [OracleA a] -> Action [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((OracleA a -> a) -> [OracleA a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map OracleA a -> a
forall a. OracleA a -> a
fromOracleA) (Action [OracleA a] -> Action [a])
-> ([q] -> Action [OracleA a]) -> [q] -> Action [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OracleQ q] -> Action [OracleA a]
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
Typeable value) =>
[key] -> Action [value]
apply ([OracleQ q] -> Action [OracleA a])
-> ([q] -> [OracleQ q]) -> [q] -> Action [OracleA a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (q -> OracleQ q) -> [q] -> [OracleQ q]
forall a b. (a -> b) -> [a] -> [b]
map q -> OracleQ q
forall question. question -> OracleQ question
OracleQ