{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable, ViewPatterns #-}
{-# LANGUAGE ExistentialQuantification, DeriveFunctor, RecordWildCards, FlexibleInstances #-}
module Development.Shake.Internal.Core.Types(
BuiltinRun, BuiltinLint, BuiltinIdentity,
RunMode(..), RunResult(..), RunChanged(..),
UserRule(..), UserRuleVersioned(..), userRuleSize,
BuiltinRule(..), Global(..), Local(..), Action(..), runAction, addDiscount,
newLocal, localClearMutable, localMergeMutable,
Traces, newTrace, addTrace, flattenTraces,
DependsList, flattenDepends, enumerateDepends, addDepends, addDepends1, newDepends,
Stack, Step(..), Result(..), Database, DatabasePoly(..), Depends(..), Status(..), Trace(..), BS_Store,
getResult, exceptionStack, statusType, addStack, addCallStack,
incStep, emptyStack, topStack, showTopStack,
stepKey, StepKey(..),
rootKey, Root(..)
) where
import Control.Monad.IO.Class
import Control.DeepSeq
import Foreign.Storable
import Data.Word
import Data.Typeable
import General.Binary
import Data.Maybe
import Data.List
import Control.Exception
import General.Extra
import Development.Shake.Internal.Core.Database
import Development.Shake.Internal.History.Shared
import Development.Shake.Internal.History.Cloud
import Development.Shake.Internal.History.Types
import Development.Shake.Internal.Errors
import qualified General.TypeMap as TMap
import Data.IORef
import qualified Data.ByteString.Char8 as BS
import Numeric.Extra
import System.Time.Extra
import General.Intern(Id)
import qualified Data.HashSet as Set
import qualified Data.HashMap.Strict as Map
import Data.Tuple.Extra
import General.Pool
import Development.Shake.Internal.Core.Monad
import Development.Shake.Internal.Value
import Development.Shake.Internal.Options
import Development.Shake.Classes
import Data.Semigroup
import General.Cleanup
import Control.Monad.Fail
import Prelude
newtype Action a = Action {forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction :: RAW ([String],[Key]) [Value] Global Local a}
deriving (forall a b. a -> Action b -> Action a
forall a b. (a -> b) -> Action a -> Action 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 -> Action b -> Action a
$c<$ :: forall a b. a -> Action b -> Action a
fmap :: forall a b. (a -> b) -> Action a -> Action b
$cfmap :: forall a b. (a -> b) -> Action a -> Action b
Functor, Functor Action
forall a. a -> Action a
forall a b. Action a -> Action b -> Action a
forall a b. Action a -> Action b -> Action b
forall a b. Action (a -> b) -> Action a -> Action b
forall a b c. (a -> b -> c) -> Action a -> Action b -> Action 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. Action a -> Action b -> Action a
$c<* :: forall a b. Action a -> Action b -> Action a
*> :: forall a b. Action a -> Action b -> Action b
$c*> :: forall a b. Action a -> Action b -> Action b
liftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
$cliftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
<*> :: forall a b. Action (a -> b) -> Action a -> Action b
$c<*> :: forall a b. Action (a -> b) -> Action a -> Action b
pure :: forall a. a -> Action a
$cpure :: forall a. a -> Action a
Applicative, Applicative Action
forall a. a -> Action a
forall a b. Action a -> Action b -> Action b
forall a b. Action a -> (a -> Action b) -> Action 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 -> Action a
$creturn :: forall a. a -> Action a
>> :: forall a b. Action a -> Action b -> Action b
$c>> :: forall a b. Action a -> Action b -> Action b
>>= :: forall a b. Action a -> (a -> Action b) -> Action b
$c>>= :: forall a b. Action a -> (a -> Action b) -> Action b
Monad, Monad Action
forall a. IO a -> Action a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Action a
$cliftIO :: forall a. IO a -> Action a
MonadIO, Typeable, NonEmpty (Action a) -> Action a
Action a -> Action a -> Action a
forall b. Integral b => b -> Action a -> Action a
forall a. Semigroup a => NonEmpty (Action a) -> Action a
forall a. Semigroup a => Action a -> Action a -> Action a
forall a b. (Semigroup a, Integral b) => b -> Action a -> Action a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Action a -> Action a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Action a -> Action a
sconcat :: NonEmpty (Action a) -> Action a
$csconcat :: forall a. Semigroup a => NonEmpty (Action a) -> Action a
<> :: Action a -> Action a -> Action a
$c<> :: forall a. Semigroup a => Action a -> Action a -> Action a
Semigroup, Action a
[Action a] -> Action a
Action a -> Action a -> Action a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Action a)
forall a. Monoid a => Action a
forall a. Monoid a => [Action a] -> Action a
forall a. Monoid a => Action a -> Action a -> Action a
mconcat :: [Action a] -> Action a
$cmconcat :: forall a. Monoid a => [Action a] -> Action a
mappend :: Action a -> Action a -> Action a
$cmappend :: forall a. Monoid a => Action a -> Action a -> Action a
mempty :: Action a
$cmempty :: forall a. Monoid a => Action a
Monoid, Monad Action
forall a. String -> Action a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Action a
$cfail :: forall a. String -> Action a
MonadFail)
runAction :: Global -> Local -> Action a -> Capture (Either SomeException a)
runAction :: forall a.
Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
g Local
l (Action RAW ([String], [Key]) [Value] Global Local a
x) = forall k v ro rw a.
([k] -> RAW k v ro rw [v])
-> ro -> rw -> RAW k v ro rw a -> Capture (Either SomeException a)
runRAW (forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([String], [Key])] -> Action [[Value]]
build) Global
g Local
l RAW ([String], [Key]) [Value] Global Local a
x
where
build :: [([String], [Key])] -> Action [[Value]]
build :: [([String], [Key])] -> Action [[Value]]
build [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
build ks :: [([String], [Key])]
ks@(([String]
callstack,[Key]
_):[([String], [Key])]
_) = do
let kss :: [[Key]]
kss = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [([String], [Key])]
ks
forall a b. [[a]] -> [b] -> [[b]]
unconcat [[Key]]
kss forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Global -> [String] -> [Key] -> Action [Value]
globalBuild Global
g [String]
callstack (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Key]]
kss)
data RunMode
= RunDependenciesSame
| RunDependenciesChanged
deriving (RunMode -> RunMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunMode -> RunMode -> Bool
$c/= :: RunMode -> RunMode -> Bool
== :: RunMode -> RunMode -> Bool
$c== :: RunMode -> RunMode -> Bool
Eq,Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunMode] -> ShowS
$cshowList :: [RunMode] -> ShowS
show :: RunMode -> String
$cshow :: RunMode -> String
showsPrec :: Int -> RunMode -> ShowS
$cshowsPrec :: Int -> RunMode -> ShowS
Show)
instance NFData RunMode where rnf :: RunMode -> ()
rnf RunMode
x = RunMode
x seq :: forall a b. a -> b -> b
`seq` ()
data RunChanged
= ChangedNothing
| ChangedStore
| ChangedRecomputeSame
| ChangedRecomputeDiff
deriving (RunChanged -> RunChanged -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunChanged -> RunChanged -> Bool
$c/= :: RunChanged -> RunChanged -> Bool
== :: RunChanged -> RunChanged -> Bool
$c== :: RunChanged -> RunChanged -> Bool
Eq,Int -> RunChanged -> ShowS
[RunChanged] -> ShowS
RunChanged -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunChanged] -> ShowS
$cshowList :: [RunChanged] -> ShowS
show :: RunChanged -> String
$cshow :: RunChanged -> String
showsPrec :: Int -> RunChanged -> ShowS
$cshowsPrec :: Int -> RunChanged -> ShowS
Show)
instance NFData RunChanged where rnf :: RunChanged -> ()
rnf RunChanged
x = RunChanged
x seq :: forall a b. a -> b -> b
`seq` ()
data RunResult value = RunResult
{forall value. RunResult value -> RunChanged
runChanged :: RunChanged
,forall value. RunResult value -> ByteString
runStore :: BS.ByteString
,forall value. RunResult value -> value
runValue :: value
} deriving forall a b. a -> RunResult b -> RunResult a
forall a b. (a -> b) -> RunResult a -> RunResult 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 -> RunResult b -> RunResult a
$c<$ :: forall a b. a -> RunResult b -> RunResult a
fmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
$cfmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
Functor
instance NFData value => NFData (RunResult value) where
rnf :: RunResult value -> ()
rnf (RunResult RunChanged
x1 ByteString
x2 value
x3) = forall a. NFData a => a -> ()
rnf RunChanged
x1 seq :: forall a b. a -> b -> b
`seq` ByteString
x2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf value
x3
newtype Step = Step Word32 deriving (Step -> Step -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq,Eq Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
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 :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmax :: Step -> Step -> Step
>= :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c< :: Step -> Step -> Bool
compare :: Step -> Step -> Ordering
$ccompare :: Step -> Step -> Ordering
Ord,Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show,Ptr Step -> IO Step
Ptr Step -> Int -> IO Step
Ptr Step -> Int -> Step -> IO ()
Ptr Step -> Step -> IO ()
Step -> Int
forall b. Ptr b -> Int -> IO Step
forall b. Ptr b -> Int -> Step -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr Step -> Step -> IO ()
$cpoke :: Ptr Step -> Step -> IO ()
peek :: Ptr Step -> IO Step
$cpeek :: Ptr Step -> IO Step
pokeByteOff :: forall b. Ptr b -> Int -> Step -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Step -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO Step
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Step
pokeElemOff :: Ptr Step -> Int -> Step -> IO ()
$cpokeElemOff :: Ptr Step -> Int -> Step -> IO ()
peekElemOff :: Ptr Step -> Int -> IO Step
$cpeekElemOff :: Ptr Step -> Int -> IO Step
alignment :: Step -> Int
$calignment :: Step -> Int
sizeOf :: Step -> Int
$csizeOf :: Step -> Int
Storable,ByteString -> Step
Step -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> Step
$cgetEx :: ByteString -> Step
putEx :: Step -> Builder
$cputEx :: Step -> Builder
BinaryEx,Step -> ()
forall a. (a -> ()) -> NFData a
rnf :: Step -> ()
$crnf :: Step -> ()
NFData,Eq Step
Int -> Step -> Int
Step -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Step -> Int
$chash :: Step -> Int
hashWithSalt :: Int -> Step -> Int
$chashWithSalt :: Int -> Step -> Int
Hashable,Typeable)
incStep :: Step -> Step
incStep (Step Word32
i) = Word32 -> Step
Step forall a b. (a -> b) -> a -> b
$ Word32
i forall a. Num a => a -> a -> a
+ Word32
1
newtype StepKey = StepKey ()
deriving (Int -> StepKey -> ShowS
[StepKey] -> ShowS
StepKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StepKey] -> ShowS
$cshowList :: [StepKey] -> ShowS
show :: StepKey -> String
$cshow :: StepKey -> String
showsPrec :: Int -> StepKey -> ShowS
$cshowsPrec :: Int -> StepKey -> ShowS
Show,StepKey -> StepKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StepKey -> StepKey -> Bool
$c/= :: StepKey -> StepKey -> Bool
== :: StepKey -> StepKey -> Bool
$c== :: StepKey -> StepKey -> Bool
Eq,Typeable,Eq StepKey
Int -> StepKey -> Int
StepKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StepKey -> Int
$chash :: StepKey -> Int
hashWithSalt :: Int -> StepKey -> Int
$chashWithSalt :: Int -> StepKey -> Int
Hashable,Get StepKey
[StepKey] -> Put
StepKey -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [StepKey] -> Put
$cputList :: [StepKey] -> Put
get :: Get StepKey
$cget :: Get StepKey
put :: StepKey -> Put
$cput :: StepKey -> Put
Binary,ByteString -> StepKey
StepKey -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> StepKey
$cgetEx :: ByteString -> StepKey
putEx :: StepKey -> Builder
$cputEx :: StepKey -> Builder
BinaryEx,StepKey -> ()
forall a. (a -> ()) -> NFData a
rnf :: StepKey -> ()
$crnf :: StepKey -> ()
NFData)
stepKey :: Key
stepKey :: Key
stepKey = forall a. ShakeValue a => a -> Key
newKey forall a b. (a -> b) -> a -> b
$ () -> StepKey
StepKey ()
newtype Root = Root () deriving (Root -> Root -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c== :: Root -> Root -> Bool
Eq,Typeable,Eq Root
Int -> Root -> Int
Root -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Root -> Int
$chash :: Root -> Int
hashWithSalt :: Int -> Root -> Int
$chashWithSalt :: Int -> Root -> Int
Hashable,Get Root
[Root] -> Put
Root -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Root] -> Put
$cputList :: [Root] -> Put
get :: Get Root
$cget :: Get Root
put :: Root -> Put
$cput :: Root -> Put
Binary,ByteString -> Root
Root -> Builder
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> Root
$cgetEx :: ByteString -> Root
putEx :: Root -> Builder
$cputEx :: Root -> Builder
BinaryEx,Root -> ()
forall a. (a -> ()) -> NFData a
rnf :: Root -> ()
$crnf :: Root -> ()
NFData)
instance Show Root where
show :: Root -> String
show (Root ()) = String
"Root"
rootKey :: Key
rootKey :: Key
rootKey = forall a. ShakeValue a => a -> Key
newKey forall a b. (a -> b) -> a -> b
$ () -> Root
Root ()
data Stack = Stack (Maybe Key) [Either Key [String]] !(Set.HashSet Id) deriving Int -> Stack -> ShowS
[Stack] -> ShowS
Stack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack] -> ShowS
$cshowList :: [Stack] -> ShowS
show :: Stack -> String
$cshow :: Stack -> String
showsPrec :: Int -> Stack -> ShowS
$cshowsPrec :: Int -> Stack -> ShowS
Show
exceptionStack :: Stack -> SomeException -> ShakeException
exceptionStack :: Stack -> SomeException -> ShakeException
exceptionStack stack :: Stack
stack@(Stack Maybe Key
_ [Either Key [String]]
xs1 HashSet Id
_) (SomeException -> ([String], SomeException)
callStackFromException -> ([String]
xs2, SomeException
e)) =
String -> [String] -> SomeException -> ShakeException
ShakeException
(Stack -> String
showTopStack Stack
stack)
([String]
xs forall a. [a] -> [a] -> [a]
++ [String
"* Raised the exception:" | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs])
SomeException
e
where
xs :: [String]
xs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Show a => Either a [String] -> [String]
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Either Key [String]]
xs1 forall a. [a] -> [a] -> [a]
++ [forall a b. b -> Either a b
Right [String]
xs2]
f :: Either a [String] -> [String]
f (Left a
x) = [String
"* Depends on: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x]
f (Right [String]
x) = forall a b. (a -> b) -> [a] -> [b]
map (String
" at " forall a. [a] -> [a] -> [a]
++) [String]
x
showTopStack :: Stack -> String
showTopStack :: Stack -> String
showTopStack = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> Maybe Key
topStack
addStack :: Id -> Key -> Stack -> Either SomeException Stack
addStack :: Id -> Key -> Stack -> Either SomeException Stack
addStack Id
i Key
k (Stack Maybe Key
_ [Either Key [String]]
ks HashSet Id
is)
| Id
i forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Id
is = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ Stack -> SomeException -> ShakeException
exceptionStack Stack
stack2 forall a b. (a -> b) -> a -> b
$ TypeRep -> String -> SomeException
errorRuleRecursion (Key -> TypeRep
typeKey Key
k) (forall a. Show a => a -> String
show Key
k)
| Bool
otherwise = forall a b. b -> Either a b
Right Stack
stack2
where stack2 :: Stack
stack2 = Maybe Key -> [Either Key [String]] -> HashSet Id -> Stack
Stack (forall a. a -> Maybe a
Just Key
k) (forall a b. a -> Either a b
Left Key
kforall a. a -> [a] -> [a]
:[Either Key [String]]
ks) (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert Id
i HashSet Id
is)
addCallStack :: [String] -> Stack -> Stack
addCallStack :: [String] -> Stack -> Stack
addCallStack [String]
xs (Stack Maybe Key
t [Either Key [String]]
a HashSet Id
b) = Maybe Key -> [Either Key [String]] -> HashSet Id -> Stack
Stack Maybe Key
t (forall a b. b -> Either a b
Right [String]
xs forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== forall a b. b -> Either a b
Right [String]
xs) [Either Key [String]]
a) HashSet Id
b
topStack :: Stack -> Maybe Key
topStack :: Stack -> Maybe Key
topStack (Stack Maybe Key
t [Either Key [String]]
_ HashSet Id
_) = Maybe Key
t
emptyStack :: Stack
emptyStack :: Stack
emptyStack = Maybe Key -> [Either Key [String]] -> HashSet Id -> Stack
Stack forall a. Maybe a
Nothing [] forall a. HashSet a
Set.empty
data Trace = Trace
{Trace -> ByteString
traceMessage :: {-# UNPACK #-} !BS.ByteString
,Trace -> Float
traceStart :: {-# UNPACK #-} !Float
,Trace -> Float
traceEnd :: {-# UNPACK #-} !Float
}
deriving Int -> Trace -> ShowS
[Trace] -> ShowS
Trace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trace] -> ShowS
$cshowList :: [Trace] -> ShowS
show :: Trace -> String
$cshow :: Trace -> String
showsPrec :: Int -> Trace -> ShowS
$cshowsPrec :: Int -> Trace -> ShowS
Show
instance NFData Trace where
rnf :: Trace -> ()
rnf Trace
x = Trace
x seq :: forall a b. a -> b -> b
`seq` ()
instance BinaryEx Trace where
putEx :: Trace -> Builder
putEx (Trace ByteString
a Float
b Float
c) = forall a. BinaryEx a => a -> Builder
putEx Float
b forall a. Semigroup a => a -> a -> a
<> forall a. BinaryEx a => a -> Builder
putEx Float
c forall a. Semigroup a => a -> a -> a
<> forall a. BinaryEx a => a -> Builder
putEx ByteString
a
getEx :: ByteString -> Trace
getEx ByteString
x | (Float
b,Float
c,ByteString
a) <- forall a b.
(Storable a, Storable b) =>
ByteString -> (a, b, ByteString)
binarySplit2 ByteString
x = ByteString -> Float -> Float -> Trace
Trace ByteString
a Float
b Float
c
instance BinaryEx [Trace] where
putEx :: [Trace] -> Builder
putEx = [Builder] -> Builder
putExList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. BinaryEx a => a -> Builder
putEx
getEx :: ByteString -> [Trace]
getEx = forall a b. (a -> b) -> [a] -> [b]
map forall a. BinaryEx a => ByteString -> a
getEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
getExList
newTrace :: String -> Seconds -> Seconds -> Trace
newTrace :: String -> Seconds -> Seconds -> Trace
newTrace String
msg Seconds
start Seconds
stop = ByteString -> Float -> Float -> Trace
Trace (String -> ByteString
BS.pack String
msg) (Seconds -> Float
doubleToFloat Seconds
start) (Seconds -> Float
doubleToFloat Seconds
stop)
type OneShot a = a
data Status
= Ready !(Result (Value, OneShot BS_Store))
| Failed !SomeException !(OneShot (Maybe (Result BS_Store)))
| Loaded !(Result BS_Store)
| Running !(NoShow (Either SomeException (Result (Value, BS_Store)) -> Locked ())) (Maybe (Result BS_Store))
| Missing
deriving Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show
instance NFData Status where
rnf :: Status -> ()
rnf Status
x = case Status
x of
Ready Result (Value, ByteString)
x -> forall a. NFData a => a -> ()
rnf Result (Value, ByteString)
x
Failed SomeException
x OneShot (Maybe (Result ByteString))
y -> SomeException -> ()
rnfException SomeException
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf OneShot (Maybe (Result ByteString))
y
Loaded Result ByteString
x -> forall a. NFData a => a -> ()
rnf Result ByteString
x
Running NoShow
(Either SomeException (Result (Value, ByteString)) -> Locked ())
_ OneShot (Maybe (Result ByteString))
x -> forall a. NFData a => a -> ()
rnf OneShot (Maybe (Result ByteString))
x
Status
Missing -> ()
where
rnfException :: SomeException -> ()
rnfException = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
data Result a = Result
{forall a. Result a -> a
result :: !a
,forall a. Result a -> Step
built :: {-# UNPACK #-} !Step
,forall a. Result a -> Step
changed :: {-# UNPACK #-} !Step
,forall a. Result a -> [Depends]
depends :: ![Depends]
,forall a. Result a -> Float
execution :: {-# UNPACK #-} !Float
,forall a. Result a -> [Trace]
traces :: ![Trace]
} deriving (Int -> Result a -> ShowS
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show,forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result 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 -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: forall a b. (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)
instance NFData a => NFData (Result a) where
rnf :: Result a -> ()
rnf (Result a
a Step
_ Step
_ [Depends]
b Float
_ [Trace]
c) = forall a. NFData a => a -> ()
rnf a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Depends]
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Trace]
c
statusType :: Status -> String
statusType Ready{} = String
"Ready"
statusType Failed{} = String
"Failed"
statusType Loaded{} = String
"Loaded"
statusType Running{} = String
"Running"
statusType Missing{} = String
"Missing"
getResult :: Status -> Maybe (Result (Either BS_Store Value))
getResult :: Status -> Maybe (Result (Either ByteString Value))
getResult (Ready Result (Value, ByteString)
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (Value, ByteString)
r
getResult (Loaded Result ByteString
r) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result ByteString
r
getResult (Running NoShow
(Either SomeException (Result (Value, ByteString)) -> Locked ())
_ OneShot (Maybe (Result ByteString))
r) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OneShot (Maybe (Result ByteString))
r
getResult Status
_ = forall a. Maybe a
Nothing
newtype Depends = Depends {Depends -> [Id]
fromDepends :: [Id]}
deriving (Depends -> ()
forall a. (a -> ()) -> NFData a
rnf :: Depends -> ()
$crnf :: Depends -> ()
NFData, NonEmpty Depends -> Depends
Depends -> Depends -> Depends
forall b. Integral b => b -> Depends -> Depends
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Depends -> Depends
$cstimes :: forall b. Integral b => b -> Depends -> Depends
sconcat :: NonEmpty Depends -> Depends
$csconcat :: NonEmpty Depends -> Depends
<> :: Depends -> Depends -> Depends
$c<> :: Depends -> Depends -> Depends
Semigroup, Semigroup Depends
Depends
[Depends] -> Depends
Depends -> Depends -> Depends
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Depends] -> Depends
$cmconcat :: [Depends] -> Depends
mappend :: Depends -> Depends -> Depends
$cmappend :: Depends -> Depends -> Depends
mempty :: Depends
$cmempty :: Depends
Monoid)
instance Show Depends where
show :: Depends -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depends -> [Id]
fromDepends
instance BinaryEx Depends where
putEx :: Depends -> Builder
putEx (Depends [Id]
xs) = forall a. Storable a => [a] -> Builder
putExStorableList [Id]
xs
getEx :: ByteString -> Depends
getEx = [Id] -> Depends
Depends forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => ByteString -> [a]
getExStorableList
instance BinaryEx [Depends] where
putEx :: [Depends] -> Builder
putEx = [Builder] -> Builder
putExList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. BinaryEx a => a -> Builder
putEx
getEx :: ByteString -> [Depends]
getEx = forall a b. (a -> b) -> [a] -> [b]
map forall a. BinaryEx a => ByteString -> a
getEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
getExList
data DependsList
= DependsNone
| DependsDirect [Depends]
| DependsSequence DependsList DependsList
| DependsSequence1 DependsList Depends
| DependsParallel [DependsList]
newDepends :: [Depends] -> DependsList
newDepends :: [Depends] -> DependsList
newDepends = [Depends] -> DependsList
DependsDirect
addDepends :: DependsList -> DependsList -> DependsList
addDepends :: DependsList -> DependsList -> DependsList
addDepends = DependsList -> DependsList -> DependsList
DependsSequence
addDepends1 :: DependsList -> Depends -> DependsList
addDepends1 :: DependsList -> Depends -> DependsList
addDepends1 = DependsList -> Depends -> DependsList
DependsSequence1
flattenDepends :: DependsList -> [Depends]
flattenDepends :: DependsList -> [Depends]
flattenDepends DependsList
d = HashSet Id -> [Depends] -> [Depends]
fMany forall a. HashSet a
Set.empty forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends] -> [Depends]
flat DependsList
d []
where
flat :: DependsList -> [Depends] -> [Depends]
flat :: DependsList -> [Depends] -> [Depends]
flat DependsList
DependsNone [Depends]
rest = [Depends]
rest
flat (DependsDirect [Depends]
xs) [Depends]
rest = [Depends]
xs forall a. [a] -> [a] -> [a]
++ [Depends]
rest
flat (DependsSequence DependsList
xs DependsList
ys) [Depends]
rest = DependsList -> [Depends] -> [Depends]
flat DependsList
xs forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends] -> [Depends]
flat DependsList
ys [Depends]
rest
flat (DependsSequence1 DependsList
xs Depends
y) [Depends]
rest = DependsList -> [Depends] -> [Depends]
flat DependsList
xs forall a b. (a -> b) -> a -> b
$ Depends
yforall a. a -> [a] -> [a]
:[Depends]
rest
flat (DependsParallel [DependsList]
xs) [Depends]
rest = forall a b. (a -> b) -> [a] -> [b]
map forall a. Monoid a => [a] -> a
mconcat [[Depends]]
xss forall a. [a] -> [a] -> [a]
++ [Depends]
rest
where xss :: [[Depends]]
xss = forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (DependsList -> [Depends] -> [Depends]
`flat` []) [DependsList]
xs
fMany :: HashSet Id -> [Depends] -> [Depends]
fMany HashSet Id
_ [] = []
fMany HashSet Id
seen (Depends [Id]
d:[Depends]
ds) = [[Id] -> Depends
Depends [Id]
d2 | [Id]
d2 forall a. Eq a => a -> a -> Bool
/= []] forall a. [a] -> [a] -> [a]
++ HashSet Id -> [Depends] -> [Depends]
fMany HashSet Id
seen2 [Depends]
ds
where ([Id]
d2,HashSet Id
seen2) = forall {a}. Hashable a => HashSet a -> [a] -> ([a], HashSet a)
fOne HashSet Id
seen [Id]
d
fOne :: HashSet a -> [a] -> ([a], HashSet a)
fOne HashSet a
seen [] = ([], HashSet a
seen)
fOne HashSet a
seen (a
x:[a]
xs) | a
x forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet a
seen = HashSet a -> [a] -> ([a], HashSet a)
fOne HashSet a
seen [a]
xs
fOne HashSet a
seen (a
x:[a]
xs) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a
xforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ HashSet a -> [a] -> ([a], HashSet a)
fOne (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert a
x HashSet a
seen) [a]
xs
enumerateDepends :: DependsList -> [Depends]
enumerateDepends :: DependsList -> [Depends]
enumerateDepends DependsList
d = DependsList -> [Depends] -> [Depends]
f DependsList
d []
where
f :: DependsList -> [Depends] -> [Depends]
f DependsList
DependsNone [Depends]
rest = [Depends]
rest
f (DependsDirect [Depends]
xs) [Depends]
rest = [Depends]
xs forall a. [a] -> [a] -> [a]
++ [Depends]
rest
f (DependsSequence DependsList
xs DependsList
ys) [Depends]
rest = DependsList -> [Depends] -> [Depends]
f DependsList
xs forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends] -> [Depends]
f DependsList
ys [Depends]
rest
f (DependsSequence1 DependsList
xs Depends
y) [Depends]
rest = DependsList -> [Depends] -> [Depends]
f DependsList
xs (Depends
yforall a. a -> [a] -> [a]
:[Depends]
rest)
f (DependsParallel []) [Depends]
rest = [Depends]
rest
f (DependsParallel (DependsList
x:[DependsList]
xs)) [Depends]
rest = DependsList -> [Depends] -> [Depends]
f DependsList
x forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends] -> [Depends]
f ([DependsList] -> DependsList
DependsParallel [DependsList]
xs) [Depends]
rest
type BuiltinRun key value
= key
-> Maybe BS.ByteString
-> RunMode
-> Action (RunResult value)
type BuiltinLint key value = key -> value -> IO (Maybe String)
type BuiltinIdentity key value = key -> value -> Maybe BS.ByteString
data BuiltinRule = BuiltinRule
{BuiltinRule -> BuiltinLint Key Value
builtinLint :: BuiltinLint Key Value
,BuiltinRule -> BuiltinIdentity Key Value
builtinIdentity :: BuiltinIdentity Key Value
,BuiltinRule -> BuiltinRun Key Value
builtinRun :: BuiltinRun Key Value
,BuiltinRule -> BinaryOp Key
builtinKey :: BinaryOp Key
,BuiltinRule -> Ver
builtinVersion :: Ver
,BuiltinRule -> String
builtinLocation :: String
}
data UserRule a
= UserRule a
| Unordered [UserRule a]
| Priority Double (UserRule a)
| Alternative (UserRule a)
| Versioned Ver (UserRule a)
deriving (UserRule a -> UserRule a -> Bool
forall a. Eq a => UserRule a -> UserRule a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserRule a -> UserRule a -> Bool
$c/= :: forall a. Eq a => UserRule a -> UserRule a -> Bool
== :: UserRule a -> UserRule a -> Bool
$c== :: forall a. Eq a => UserRule a -> UserRule a -> Bool
Eq,Int -> UserRule a -> ShowS
forall a. Show a => Int -> UserRule a -> ShowS
forall a. Show a => [UserRule a] -> ShowS
forall a. Show a => UserRule a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserRule a] -> ShowS
$cshowList :: forall a. Show a => [UserRule a] -> ShowS
show :: UserRule a -> String
$cshow :: forall a. Show a => UserRule a -> String
showsPrec :: Int -> UserRule a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> UserRule a -> ShowS
Show,forall a b. a -> UserRule b -> UserRule a
forall a b. (a -> b) -> UserRule a -> UserRule 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 -> UserRule b -> UserRule a
$c<$ :: forall a b. a -> UserRule b -> UserRule a
fmap :: forall a b. (a -> b) -> UserRule a -> UserRule b
$cfmap :: forall a b. (a -> b) -> UserRule a -> UserRule b
Functor,Typeable)
data UserRuleVersioned a = UserRuleVersioned
{forall a. UserRuleVersioned a -> Bool
userRuleVersioned :: Bool
,forall a. UserRuleVersioned a -> UserRule a
userRuleContents :: UserRule a
}
instance Semigroup (UserRuleVersioned a) where
UserRuleVersioned Bool
b1 UserRule a
x1 <> :: UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
<> UserRuleVersioned Bool
b2 UserRule a
x2 = forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned (Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) (UserRule a
x1 forall a. Semigroup a => a -> a -> a
<> UserRule a
x2)
instance Monoid (UserRuleVersioned a) where
mempty :: UserRuleVersioned a
mempty = forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
False forall a. Monoid a => a
mempty
mappend :: UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (UserRule a) where
UserRule a
x <> :: UserRule a -> UserRule a -> UserRule a
<> UserRule a
y = forall a. [UserRule a] -> UserRule a
Unordered [UserRule a
x,UserRule a
y]
instance Monoid (UserRule a) where
mempty :: UserRule a
mempty = forall a. [UserRule a] -> UserRule a
Unordered []
mappend :: UserRule a -> UserRule a -> UserRule a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
userRuleSize :: UserRule a -> Int
userRuleSize :: forall a. UserRule a -> Int
userRuleSize UserRule{} = Int
1
userRuleSize (Unordered [UserRule a]
xs) = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. UserRule a -> Int
userRuleSize [UserRule a]
xs
userRuleSize (Priority Seconds
_ UserRule a
x) = forall a. UserRule a -> Int
userRuleSize UserRule a
x
userRuleSize (Alternative UserRule a
x) = forall a. UserRule a -> Int
userRuleSize UserRule a
x
userRuleSize (Versioned Ver
_ UserRule a
x) = forall a. UserRule a -> Int
userRuleSize UserRule a
x
type Database = DatabasePoly Key Status
data Global = Global
{Global -> [String] -> [Key] -> Action [Value]
globalBuild :: [String] -> [Key] -> Action [Value]
,Global -> Database
globalDatabase :: Database
,Global -> Pool
globalPool :: Pool
,Global -> Cleanup
globalCleanup :: Cleanup
,Global -> IO Seconds
globalTimestamp :: IO Seconds
,Global -> HashMap TypeRep BuiltinRule
globalRules :: Map.HashMap TypeRep BuiltinRule
,Global -> Verbosity -> String -> IO ()
globalOutput :: Verbosity -> String -> IO ()
,Global -> ShakeOptions
globalOptions :: ShakeOptions
,Global -> IO String -> IO ()
globalDiagnostic :: IO String -> IO ()
,Global -> Key -> Action ()
globalRuleFinished :: Key -> Action ()
,Global -> IORef [IO ()]
globalAfter :: IORef [IO ()]
,Global -> IORef [(Key, Key)]
globalTrackAbsent :: IORef [(Key, Key)]
,Global -> IO Progress
globalProgress :: IO Progress
,Global -> Map UserRuleVersioned
globalUserRules :: TMap.Map UserRuleVersioned
,Global -> Maybe Shared
globalShared :: Maybe Shared
,Global -> Maybe Cloud
globalCloud :: Maybe Cloud
,Global -> Step
globalStep :: {-# UNPACK #-} !Step
,Global -> Bool
globalOneShot :: Bool
}
data Local = Local
{Local -> Stack
localStack :: Stack
,Local -> Ver
localBuiltinVersion :: Ver
,Local -> Verbosity
localVerbosity :: Verbosity
,Local -> Maybe String
localBlockApply :: Maybe String
,Local -> DependsList
localDepends :: DependsList
,Local -> Seconds
localDiscount :: !Seconds
,Local -> Traces
localTraces :: Traces
,Local -> [Key -> Bool]
localTrackAllows :: [Key -> Bool]
,Local -> [Key]
localTrackRead :: [Key]
,Local -> [Key]
localTrackWrite :: [Key]
,Local -> [(Bool, String)]
localProduces :: [(Bool, FilePath)]
,Local -> Bool
localHistory :: !Bool
}
data Traces
= TracesNone
| TracesSequence1 Traces Trace
| TracesSequence Traces Traces
| TracesParallel [Traces]
flattenTraces :: Traces -> [Trace]
flattenTraces :: Traces -> [Trace]
flattenTraces Traces
t = Traces -> [Trace] -> [Trace]
f Traces
t []
where
f :: Traces -> [Trace] -> [Trace]
f Traces
TracesNone [Trace]
rest = [Trace]
rest
f (TracesSequence1 Traces
a Trace
b) [Trace]
rest = Traces -> [Trace] -> [Trace]
f Traces
a (Trace
bforall a. a -> [a] -> [a]
:[Trace]
rest)
f (TracesSequence Traces
a Traces
b) [Trace]
rest = Traces -> [Trace] -> [Trace]
f Traces
a forall a b. (a -> b) -> a -> b
$ Traces -> [Trace] -> [Trace]
f Traces
b [Trace]
rest
f (TracesParallel []) [Trace]
rest = [Trace]
rest
f (TracesParallel (Traces
x:[Traces]
xs)) [Trace]
rest = Traces -> [Trace] -> [Trace]
f Traces
x forall a b. (a -> b) -> a -> b
$ Traces -> [Trace] -> [Trace]
f ([Traces] -> Traces
TracesParallel [Traces]
xs) [Trace]
rest
addTrace :: Traces -> Trace -> Traces
addTrace :: Traces -> Trace -> Traces
addTrace Traces
ts Trace
t = Traces
ts Traces -> Trace -> Traces
`TracesSequence1` Trace
t
addDiscount :: Seconds -> Local -> Local
addDiscount :: Seconds -> Local -> Local
addDiscount Seconds
s Local
l = Local
l{localDiscount :: Seconds
localDiscount = Seconds
s forall a. Num a => a -> a -> a
+ Local -> Seconds
localDiscount Local
l}
newLocal :: Stack -> Verbosity -> Local
newLocal :: Stack -> Verbosity -> Local
newLocal Stack
stack Verbosity
verb = Stack
-> Ver
-> Verbosity
-> Maybe String
-> DependsList
-> Seconds
-> Traces
-> [Key -> Bool]
-> [Key]
-> [Key]
-> [(Bool, String)]
-> Bool
-> Local
Local Stack
stack (Int -> Ver
Ver Int
0) Verbosity
verb forall a. Maybe a
Nothing DependsList
DependsNone Seconds
0 Traces
TracesNone [] [] [] [] Bool
True
localClearMutable :: Local -> Local
localClearMutable :: Local -> Local
localClearMutable Local{Bool
Seconds
[(Bool, String)]
[Key]
[Key -> Bool]
Maybe String
Ver
Verbosity
Traces
DependsList
Stack
localHistory :: Bool
localProduces :: [(Bool, String)]
localTrackWrite :: [Key]
localTrackRead :: [Key]
localTrackAllows :: [Key -> Bool]
localTraces :: Traces
localDiscount :: Seconds
localDepends :: DependsList
localBlockApply :: Maybe String
localVerbosity :: Verbosity
localBuiltinVersion :: Ver
localStack :: Stack
localHistory :: Local -> Bool
localProduces :: Local -> [(Bool, String)]
localTrackWrite :: Local -> [Key]
localTrackRead :: Local -> [Key]
localTrackAllows :: Local -> [Key -> Bool]
localTraces :: Local -> Traces
localDiscount :: Local -> Seconds
localDepends :: Local -> DependsList
localBlockApply :: Local -> Maybe String
localVerbosity :: Local -> Verbosity
localBuiltinVersion :: Local -> Ver
localStack :: Local -> Stack
..} = (Stack -> Verbosity -> Local
newLocal Stack
localStack Verbosity
localVerbosity){localBlockApply :: Maybe String
localBlockApply=Maybe String
localBlockApply, localBuiltinVersion :: Ver
localBuiltinVersion=Ver
localBuiltinVersion}
localMergeMutable :: Local -> [Local] -> Local
localMergeMutable :: Local -> [Local] -> Local
localMergeMutable Local
root [Local]
xs = Local
{localStack :: Stack
localStack = Local -> Stack
localStack Local
root
,localBuiltinVersion :: Ver
localBuiltinVersion = Local -> Ver
localBuiltinVersion Local
root
,localVerbosity :: Verbosity
localVerbosity = Local -> Verbosity
localVerbosity Local
root
,localBlockApply :: Maybe String
localBlockApply = Local -> Maybe String
localBlockApply Local
root
,localDepends :: DependsList
localDepends = [DependsList] -> DependsList
DependsParallel (forall a b. (a -> b) -> [a] -> [b]
map Local -> DependsList
localDepends [Local]
xs) DependsList -> DependsList -> DependsList
`DependsSequence` Local -> DependsList
localDepends Local
root
,localDiscount :: Seconds
localDiscount = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Local -> Seconds
localDiscount forall a b. (a -> b) -> a -> b
$ Local
root forall a. a -> [a] -> [a]
: [Local]
xs
,localTraces :: Traces
localTraces = [Traces] -> Traces
TracesParallel (forall a b. (a -> b) -> [a] -> [b]
map Local -> Traces
localTraces [Local]
xs) Traces -> Traces -> Traces
`TracesSequence` Local -> Traces
localTraces Local
root
,localTrackAllows :: [Key -> Bool]
localTrackAllows = Local -> [Key -> Bool]
localTrackAllows Local
root forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Key -> Bool]
localTrackAllows [Local]
xs
,localTrackRead :: [Key]
localTrackRead = Local -> [Key]
localTrackRead Local
root forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Key]
localTrackRead [Local]
xs
,localTrackWrite :: [Key]
localTrackWrite = Local -> [Key]
localTrackWrite Local
root forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Key]
localTrackWrite [Local]
xs
,localProduces :: [(Bool, String)]
localProduces = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [(Bool, String)]
localProduces [Local]
xs forall a. [a] -> [a] -> [a]
++ Local -> [(Bool, String)]
localProduces Local
root
,localHistory :: Bool
localHistory = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Local -> Bool
localHistory forall a b. (a -> b) -> a -> b
$ Local
rootforall a. a -> [a] -> [a]
:[Local]
xs
}