{-# 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
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
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
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {question}. Hashable question => Eq (OracleQ question)
forall question.
Hashable question =>
Int -> OracleQ question -> Int
forall question. Hashable question => OracleQ question -> Int
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
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 -> ()
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
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
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
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {answer}. Hashable answer => Eq (OracleA answer)
forall answer. Hashable answer => Int -> OracleA answer -> Int
forall answer. Hashable answer => OracleA answer -> Int
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
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 -> ()
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 :: forall a. 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
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 :: forall q a.
(Located, RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
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
"" forall a. Eq a => a -> a -> Bool
== Rebuild
RebuildLater
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
NFData value, Show value, Located) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule forall key value. BuiltinLint key value
noLint (\OracleQ q
_ OracleA a
v -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx forall a b. (a -> b) -> a -> b
$ forall a. Hashable a => a -> Int
hash OracleA a
v) 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 forall a. Eq a => a -> a -> Bool
/= Flavor
Hash Bool -> Bool -> Bool
&& Bool
skip) Bool -> Bool -> Bool
|| (Flavor
flavor forall a. Eq a => a -> a -> Bool
== Flavor
Cache Bool -> Bool -> Bool
&& RunMode
mode forall a. Eq a => a -> a -> Bool
== RunMode
RunDependenciesSame) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedNothing ByteString
old forall a b. (a -> b) -> a -> b
$ forall a. Binary a => ByteString -> a
decode' ByteString
old
Maybe ByteString
_ -> do
let cmpValue :: OracleA a -> RunChanged
cmpValue OracleA a
new = if forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Binary a => ByteString -> a
decode' Maybe ByteString
old forall a. Eq a => a -> a -> Bool
== 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 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ByteString
newHash then RunChanged
ChangedRecomputeSame else RunChanged
ChangedRecomputeDiff
Maybe ByteString
cache <- if Flavor
flavor forall a. Eq a => a -> a -> Bool
== Flavor
Cache then Int -> Action (Maybe ByteString)
historyLoad Int
0 else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
case Maybe ByteString
cache of
Just ByteString
newEncode -> do
let new :: OracleA a
new = forall a. Binary a => ByteString -> a
decode' ByteString
newEncode
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 <- forall answer. answer -> OracleA answer
OracleA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> q -> Action a
act q
q
let newHash :: ByteString
newHash = forall a. Hashable a => a -> ByteString
encodeHash OracleA a
new
let newEncode :: ByteString
newEncode = forall a. Binary a => a -> ByteString
encode' OracleA a
new
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flavor
flavor forall a. Eq a => a -> a -> Bool
== Flavor
Cache) forall a b. (a -> b) -> a -> b
$
Int -> ByteString -> Action ()
historySave Int
0 ByteString
newEncode
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Flavor
flavor forall a. Eq a => a -> a -> Bool
== Flavor
Hash
then forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult (ByteString -> RunChanged
cmpHash ByteString
newHash) ByteString
newHash OracleA a
new
else forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult (OracleA a -> RunChanged
cmpValue OracleA a
new) ByteString
newEncode OracleA a
new
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle
where
encodeHash :: Hashable a => a -> BS.ByteString
encodeHash :: forall a. Hashable a => a -> ByteString
encodeHash = Builder -> ByteString
runBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinaryEx a => a -> Builder
putEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash
encode' :: Binary a => a -> BS.ByteString
encode' :: forall a. Binary a => a -> ByteString
encode' = [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
encode
decode' :: Binary a => BS.ByteString -> a
decode' :: forall a. Binary a => ByteString -> a
decode' = forall a. Binary a => ByteString -> a
decode 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
addOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)
addOracle :: forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Located) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle = forall a. Located => (Located => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall q a.
(Located, 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 :: forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Located) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleHash = forall a. Located => (Located => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall q a.
(Located, 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 :: forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Located) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache = forall a. Located => (Located => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall q a.
(Located, 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 :: forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. OracleA a -> a
fromOracleA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Located, RuleResult key ~ value, ShakeValue key,
Typeable value) =>
key -> Action value
apply1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall question. question -> OracleQ question
OracleQ
askOracles :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => [q] -> Action [a]
askOracles :: forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
[q] -> Action [a]
askOracles = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a. OracleA a -> a
fromOracleA) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(Located, RuleResult key ~ value, ShakeValue key,
Typeable value) =>
[key] -> Action [value]
apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall question. question -> OracleQ question
OracleQ