{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
module Development.Shake.Internal.Rules.Oracle(
addOracle, addOracleCache, askOracle
) where
import Development.Shake.Internal.Core.Run
import Development.Shake.Internal.Core.Types
import Development.Shake.Internal.Core.Rules
import Development.Shake.Internal.Options
import Development.Shake.Internal.Value
import Development.Shake.Classes
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Binary
import Control.Applicative
import Prelude
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)
type instance RuleResult (OracleQ a) = OracleA (RuleResult a)
addOracleRaw :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => Bool -> (q -> Action a) -> Rules (q -> Action a)
addOracleRaw :: Bool -> (q -> Action a) -> Rules (q -> Action a)
addOracleRaw cache :: Bool
cache act :: q -> Action a
act = do
ShakeOptions
opts <- Rules ShakeOptions
getShakeOptionsRules
let skip :: Bool
skip = ShakeOptions -> String -> Rebuild
shakeRebuildApply ShakeOptions
opts "" Rebuild -> Rebuild -> Bool
forall a. Eq a => a -> a -> Bool
== Rebuild
RebuildLater
BuiltinLint (OracleQ q) (OracleA a)
-> BuiltinRun (OracleQ q) (OracleA a) -> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, ShakeValue value) =>
BuiltinLint key value -> BuiltinRun key value -> Rules ()
addBuiltinRule BuiltinLint (OracleQ q) (OracleA a)
forall key value. BuiltinLint key value
noLint (BuiltinRun (OracleQ q) (OracleA a) -> Rules ())
-> BuiltinRun (OracleQ q) (OracleA a) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(OracleQ q :: q
q) old :: Maybe ByteString
old changed :: Bool
changed -> case Maybe ByteString
old of
Just old :: ByteString
old | Bool
skip Bool -> Bool -> Bool
|| (Bool
cache Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
changed) ->
RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
_ -> 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
RunResult (OracleA a) -> Action (RunResult (OracleA a))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
(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)
(OracleA a -> ByteString
forall a. Binary a => a -> ByteString
encode' OracleA a
new)
OracleA a
new
(q -> Action a) -> Rules (q -> Action a)
forall (m :: * -> *) a. Monad m => a -> m a
return q -> Action a
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle
where
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 (m :: * -> *) a. Monad m => a -> m a
return
addOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)
addOracle :: (q -> Action a) -> Rules (q -> Action a)
addOracle = Bool -> (q -> Action a) -> Rules (q -> Action a)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
Bool -> (q -> Action a) -> Rules (q -> Action a)
addOracleRaw Bool
False
addOracleCache ::(RuleResult q ~ a, ShakeValue q, ShakeValue a) => (q -> Action a) -> Rules (q -> Action a)
addOracleCache :: (q -> Action a) -> Rules (q -> Action a)
addOracleCache = Bool -> (q -> Action a) -> Rules (q -> Action a)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
Bool -> (q -> Action a) -> Rules (q -> Action a)
addOracleRaw Bool
True
askOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => q -> Action a
askOracle :: q -> Action a
askOracle question :: q
question = do OracleA answer :: a
answer <- OracleQ q -> Action (OracleA a)
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value) =>
key -> Action value
apply1 (OracleQ q -> Action (OracleA a))
-> OracleQ q -> Action (OracleA a)
forall a b. (a -> b) -> a -> b
$ q -> OracleQ q
forall question. question -> OracleQ question
OracleQ q
question; a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return a
answer