{-# 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


---------------------------------------------------------------------
-- UNDERLYING DATA TYPE

-- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'Development.Shake.need' to execute files.
--   Action values are used by 'addUserRule' and 'action'. The 'Action' monad tracks the dependencies of a rule.
--   To raise an exception call 'error', 'fail' or @'liftIO' . 'throwIO'@.
newtype Action a = Action {Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction :: RAW ([String],[Key]) [Value] Global Local a}
    deriving (a -> Action b -> Action a
(a -> b) -> Action a -> Action b
(forall a b. (a -> b) -> Action a -> Action b)
-> (forall a b. a -> Action b -> Action a) -> Functor Action
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
<$ :: a -> Action b -> Action a
$c<$ :: forall a b. a -> Action b -> Action a
fmap :: (a -> b) -> Action a -> Action b
$cfmap :: forall a b. (a -> b) -> Action a -> Action b
Functor, Functor Action
a -> Action a
Functor Action
-> (forall a. a -> Action a)
-> (forall a b. Action (a -> b) -> Action a -> Action b)
-> (forall a b c.
    (a -> b -> c) -> Action a -> Action b -> Action c)
-> (forall a b. Action a -> Action b -> Action b)
-> (forall a b. Action a -> Action b -> Action a)
-> Applicative Action
Action a -> Action b -> Action b
Action a -> Action b -> Action a
Action (a -> b) -> Action a -> Action b
(a -> b -> c) -> Action a -> Action b -> Action c
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
<* :: Action a -> Action b -> Action a
$c<* :: forall a b. Action a -> Action b -> Action a
*> :: Action a -> Action b -> Action b
$c*> :: forall a b. Action a -> Action b -> Action b
liftA2 :: (a -> b -> c) -> Action a -> Action b -> Action c
$cliftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
<*> :: Action (a -> b) -> Action a -> Action b
$c<*> :: forall a b. Action (a -> b) -> Action a -> Action b
pure :: a -> Action a
$cpure :: forall a. a -> Action a
$cp1Applicative :: Functor Action
Applicative, Applicative Action
a -> Action a
Applicative Action
-> (forall a b. Action a -> (a -> Action b) -> Action b)
-> (forall a b. Action a -> Action b -> Action b)
-> (forall a. a -> Action a)
-> Monad Action
Action a -> (a -> Action b) -> Action b
Action a -> Action b -> Action b
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 :: a -> Action a
$creturn :: forall a. a -> Action a
>> :: Action a -> Action b -> Action b
$c>> :: forall a b. Action a -> Action b -> Action b
>>= :: Action a -> (a -> Action b) -> Action b
$c>>= :: forall a b. Action a -> (a -> Action b) -> Action b
$cp1Monad :: Applicative Action
Monad, Monad Action
Monad Action -> (forall a. IO a -> Action a) -> MonadIO Action
IO a -> Action a
forall a. IO a -> Action a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Action a
$cliftIO :: forall a. IO a -> Action a
$cp1MonadIO :: Monad Action
MonadIO, Typeable, b -> Action a -> Action a
NonEmpty (Action a) -> Action a
Action a -> Action a -> Action a
(Action a -> Action a -> Action a)
-> (NonEmpty (Action a) -> Action a)
-> (forall b. Integral b => b -> Action a -> Action a)
-> Semigroup (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 :: 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, Semigroup (Action a)
Action a
Semigroup (Action a)
-> Action a
-> (Action a -> Action a -> Action a)
-> ([Action a] -> Action a)
-> Monoid (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
$cp1Monoid :: forall a. Monoid a => Semigroup (Action a)
Monoid, Monad Action
Monad Action -> (forall a. String -> Action a) -> MonadFail Action
String -> Action a
forall a. String -> Action a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Action a
$cfail :: forall a. String -> Action a
$cp1MonadFail :: Monad Action
MonadFail)

runAction :: Global -> Local -> Action a -> Capture (Either SomeException a)
runAction :: Global -> Local -> Action a -> Capture (Either SomeException a)
runAction Global
g Local
l (Action RAW ([String], [Key]) [Value] Global Local a
x) = ([([String], [Key])]
 -> RAW ([String], [Key]) [Value] Global Local [[Value]])
-> Global
-> Local
-> RAW ([String], [Key]) [Value] Global Local a
-> Capture (Either SomeException a)
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 (Action [[Value]]
-> RAW ([String], [Key]) [Value] Global Local [[Value]]
forall a. Action a -> RAW ([String], [Key]) [Value] Global Local a
fromAction (Action [[Value]]
 -> RAW ([String], [Key]) [Value] Global Local [[Value]])
-> ([([String], [Key])] -> Action [[Value]])
-> [([String], [Key])]
-> RAW ([String], [Key]) [Value] Global Local [[Value]]
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
        -- first argument is a list of call stacks, since build only takes one we use the first
        -- they are very probably all identical...
        build :: [([String], [Key])] -> Action [[Value]]
        build :: [([String], [Key])] -> Action [[Value]]
build [] = [[Value]] -> Action [[Value]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        build ks :: [([String], [Key])]
ks@(([String]
callstack,[Key]
_):[([String], [Key])]
_) = do
            let kss :: [[Key]]
kss = (([String], [Key]) -> [Key]) -> [([String], [Key])] -> [[Key]]
forall a b. (a -> b) -> [a] -> [b]
map ([String], [Key]) -> [Key]
forall a b. (a, b) -> b
snd [([String], [Key])]
ks
            [[Key]] -> [Value] -> [[Value]]
forall a b. [[a]] -> [b] -> [[b]]
unconcat [[Key]]
kss ([Value] -> [[Value]]) -> Action [Value] -> Action [[Value]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Global -> [String] -> [Key] -> Action [Value]
globalBuild Global
g [String]
callstack ([[Key]] -> [Key]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Key]]
kss)


---------------------------------------------------------------------
-- PUBLIC TYPES

-- | What mode a rule is running in, passed as an argument to 'BuiltinRun'.
data RunMode
    = RunDependenciesSame -- ^ My dependencies have not changed.
    | RunDependenciesChanged -- ^ At least one of my dependencies from last time have changed, or I have no recorded dependencies.
      deriving (RunMode -> RunMode -> Bool
(RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool) -> Eq RunMode
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
(Int -> RunMode -> ShowS)
-> (RunMode -> String) -> ([RunMode] -> ShowS) -> Show RunMode
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 RunMode -> () -> ()
`seq` ()

-- | How the output of a rule has changed.
data RunChanged
    = ChangedNothing -- ^ Nothing has changed.
    | ChangedStore -- ^ The stored value has changed, but in a way that should be considered identical (used rarely).
    | ChangedRecomputeSame -- ^ I recomputed the value and it was the same.
    | ChangedRecomputeDiff -- ^ I recomputed the value and it was different.
      deriving (RunChanged -> RunChanged -> Bool
(RunChanged -> RunChanged -> Bool)
-> (RunChanged -> RunChanged -> Bool) -> Eq RunChanged
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
(Int -> RunChanged -> ShowS)
-> (RunChanged -> String)
-> ([RunChanged] -> ShowS)
-> Show RunChanged
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 RunChanged -> () -> ()
`seq` ()


-- | The result of 'BuiltinRun'.
data RunResult value = RunResult
    {RunResult value -> RunChanged
runChanged :: RunChanged
        -- ^ How has the 'RunResult' changed from what happened last time.
    ,RunResult value -> ByteString
runStore :: BS.ByteString
        -- ^ The value to store in the Shake database.
    ,RunResult value -> value
runValue :: value
        -- ^ The value to return from 'Development.Shake.Rule.apply'.
    } deriving a -> RunResult b -> RunResult a
(a -> b) -> RunResult a -> RunResult b
(forall a b. (a -> b) -> RunResult a -> RunResult b)
-> (forall a b. a -> RunResult b -> RunResult a)
-> Functor RunResult
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
<$ :: a -> RunResult b -> RunResult a
$c<$ :: forall a b. a -> RunResult b -> RunResult a
fmap :: (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) = RunChanged -> ()
forall a. NFData a => a -> ()
rnf RunChanged
x1 () -> () -> ()
`seq` ByteString
x2 ByteString -> () -> ()
`seq` value -> ()
forall a. NFData a => a -> ()
rnf value
x3



---------------------------------------------------------------------
-- UTILITY TYPES

newtype Step = Step Word32 deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
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
Eq Step
-> (Step -> Step -> Ordering)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Step)
-> (Step -> Step -> Step)
-> Ord 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
$cp1Ord :: Eq Step
Ord,Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
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 b -> Int -> IO Step
Ptr b -> Int -> Step -> IO ()
Ptr Step -> IO Step
Ptr Step -> Int -> IO Step
Ptr Step -> Int -> Step -> IO ()
Ptr Step -> Step -> IO ()
Step -> Int
(Step -> Int)
-> (Step -> Int)
-> (Ptr Step -> Int -> IO Step)
-> (Ptr Step -> Int -> Step -> IO ())
-> (forall b. Ptr b -> Int -> IO Step)
-> (forall b. Ptr b -> Int -> Step -> IO ())
-> (Ptr Step -> IO Step)
-> (Ptr Step -> Step -> IO ())
-> Storable Step
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 :: Ptr b -> Int -> Step -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> Step -> IO ()
peekByteOff :: 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
(Step -> Builder) -> (ByteString -> Step) -> BinaryEx Step
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> Step
$cgetEx :: ByteString -> Step
putEx :: Step -> Builder
$cputEx :: Step -> Builder
BinaryEx,Step -> ()
(Step -> ()) -> NFData Step
forall a. (a -> ()) -> NFData a
rnf :: Step -> ()
$crnf :: Step -> ()
NFData,Int -> Step -> Int
Step -> Int
(Int -> Step -> Int) -> (Step -> Int) -> Hashable Step
forall 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 (Word32 -> Step) -> Word32 -> Step
forall a b. (a -> b) -> a -> b
$ Word32
i Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1


-- To simplify journaling etc we smuggle the Step in the database, with a special StepKey
newtype StepKey = StepKey ()
    deriving (Int -> StepKey -> ShowS
[StepKey] -> ShowS
StepKey -> String
(Int -> StepKey -> ShowS)
-> (StepKey -> String) -> ([StepKey] -> ShowS) -> Show StepKey
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
(StepKey -> StepKey -> Bool)
-> (StepKey -> StepKey -> Bool) -> Eq StepKey
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,Int -> StepKey -> Int
StepKey -> Int
(Int -> StepKey -> Int) -> (StepKey -> Int) -> Hashable StepKey
forall 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
(StepKey -> Put)
-> Get StepKey -> ([StepKey] -> Put) -> Binary StepKey
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
(StepKey -> Builder) -> (ByteString -> StepKey) -> BinaryEx StepKey
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> StepKey
$cgetEx :: ByteString -> StepKey
putEx :: StepKey -> Builder
$cputEx :: StepKey -> Builder
BinaryEx,StepKey -> ()
(StepKey -> ()) -> NFData StepKey
forall a. (a -> ()) -> NFData a
rnf :: StepKey -> ()
$crnf :: StepKey -> ()
NFData)

stepKey :: Key
stepKey :: Key
stepKey = StepKey -> Key
forall a. ShakeValue a => a -> Key
newKey (StepKey -> Key) -> StepKey -> Key
forall a b. (a -> b) -> a -> b
$ () -> StepKey
StepKey ()


-- To make sure profiling has a complete view of what was demanded and all top-level 'action'
-- things we fake up a Root node representing everything that was demanded
newtype Root = Root () deriving (Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
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,Int -> Root -> Int
Root -> Int
(Int -> Root -> Int) -> (Root -> Int) -> Hashable Root
forall 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
(Root -> Put) -> Get Root -> ([Root] -> Put) -> Binary Root
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
(Root -> Builder) -> (ByteString -> Root) -> BinaryEx Root
forall a. (a -> Builder) -> (ByteString -> a) -> BinaryEx a
getEx :: ByteString -> Root
$cgetEx :: ByteString -> Root
putEx :: Root -> Builder
$cputEx :: Root -> Builder
BinaryEx,Root -> ()
(Root -> ()) -> NFData 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 = Root -> Key
forall a. ShakeValue a => a -> Key
newKey (Root -> Key) -> Root -> Key
forall a b. (a -> b) -> a -> b
$ () -> Root
Root ()


---------------------------------------------------------------------
-- CALL STACK

-- Invariant: Every key must have its Id in the set
data Stack = Stack (Maybe Key) [Either Key [String]] !(Set.HashSet Id) deriving Int -> Stack -> ShowS
[Stack] -> ShowS
Stack -> String
(Int -> Stack -> ShowS)
-> (Stack -> String) -> ([Stack] -> ShowS) -> Show Stack
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"* Raised the exception:" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs])
        SomeException
e
    where
        xs :: [String]
xs = (Either Key [String] -> [String])
-> [Either Key [String]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Key [String] -> [String]
forall a. Show a => Either a [String] -> [String]
f ([Either Key [String]] -> [String])
-> [Either Key [String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [Either Key [String]] -> [Either Key [String]]
forall a. [a] -> [a]
reverse [Either Key [String]]
xs1 [Either Key [String]]
-> [Either Key [String]] -> [Either Key [String]]
forall a. [a] -> [a] -> [a]
++ [[String] -> Either Key [String]
forall a b. b -> Either a b
Right [String]
xs2]
        f :: Either a [String] -> [String]
f (Left a
x) = [String
"* Depends on: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x]
        f (Right [String]
x) = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  at " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
x


showTopStack :: Stack -> String
showTopStack :: Stack -> String
showTopStack = String -> (Key -> String) -> Maybe Key -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<unknown>" Key -> String
forall a. Show a => a -> String
show (Maybe Key -> String) -> (Stack -> Maybe Key) -> Stack -> String
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 Id -> HashSet Id -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Id
is = SomeException -> Either SomeException Stack
forall a b. a -> Either a b
Left (SomeException -> Either SomeException Stack)
-> SomeException -> Either SomeException Stack
forall a b. (a -> b) -> a -> b
$ ShakeException -> SomeException
forall e. Exception e => e -> SomeException
toException (ShakeException -> SomeException)
-> ShakeException -> SomeException
forall a b. (a -> b) -> a -> b
$ Stack -> SomeException -> ShakeException
exceptionStack Stack
stack2 (SomeException -> ShakeException)
-> SomeException -> ShakeException
forall a b. (a -> b) -> a -> b
$ TypeRep -> String -> SomeException
errorRuleRecursion (Key -> TypeRep
typeKey Key
k) (Key -> String
forall a. Show a => a -> String
show Key
k)
    | Bool
otherwise = Stack -> Either SomeException Stack
forall a b. b -> Either a b
Right Stack
stack2
    where stack2 :: Stack
stack2 = Maybe Key -> [Either Key [String]] -> HashSet Id -> Stack
Stack (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k) (Key -> Either Key [String]
forall a b. a -> Either a b
Left Key
kEither Key [String]
-> [Either Key [String]] -> [Either Key [String]]
forall a. a -> [a] -> [a]
:[Either Key [String]]
ks) (Id -> HashSet Id -> HashSet Id
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert Id
i HashSet Id
is)

addCallStack :: [String] -> Stack -> Stack
-- use group/head to squash adjacent duplicates, e.g. a want does an action and a need, both of which get the same location
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 ([String] -> Either Key [String]
forall a b. b -> Either a b
Right [String]
xs Either Key [String]
-> [Either Key [String]] -> [Either Key [String]]
forall a. a -> [a] -> [a]
: (Either Key [String] -> Bool)
-> [Either Key [String]] -> [Either Key [String]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Either Key [String] -> Either Key [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Either Key [String]
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 Maybe Key
forall a. Maybe a
Nothing [] HashSet Id
forall a. HashSet a
Set.empty


---------------------------------------------------------------------
-- TRACE

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
(Int -> Trace -> ShowS)
-> (Trace -> String) -> ([Trace] -> ShowS) -> Show Trace
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 Trace -> () -> ()
`seq` () -- all strict atomic fields

instance BinaryEx Trace where
    putEx :: Trace -> Builder
putEx (Trace ByteString
a Float
b Float
c) = Float -> Builder
forall a. BinaryEx a => a -> Builder
putEx Float
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. BinaryEx a => a -> Builder
putEx Float
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. BinaryEx a => a -> Builder
putEx ByteString
a
    getEx :: ByteString -> Trace
getEx ByteString
x | (Float
b,Float
c,ByteString
a) <- ByteString -> (Float, Float, ByteString)
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 ([Builder] -> Builder)
-> ([Trace] -> [Builder]) -> [Trace] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trace -> Builder) -> [Trace] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Trace -> Builder
forall a. BinaryEx a => a -> Builder
putEx
    getEx :: ByteString -> [Trace]
getEx = (ByteString -> Trace) -> [ByteString] -> [Trace]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Trace
forall a. BinaryEx a => ByteString -> a
getEx ([ByteString] -> [Trace])
-> (ByteString -> [ByteString]) -> ByteString -> [Trace]
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)


---------------------------------------------------------------------
-- CENTRAL TYPES

-- Things stored under OneShot are not required if we only do one compilation,
-- but are if we do multiple, as we have to reset the database each time.
-- globalOneShot controls that, and gives us a small memory optimisation.
type OneShot a = a

data Status
    = Ready !(Result (Value, OneShot BS_Store)) -- ^ I have a value
    | Failed !SomeException !(OneShot (Maybe (Result BS_Store))) -- ^ I have been run and raised an error
    | Loaded !(Result BS_Store) -- ^ Loaded from the database
    | Running !(NoShow (Either SomeException (Result (Value, BS_Store)) -> Locked ())) (Maybe (Result BS_Store)) -- ^ Currently in the process of being checked or built
    | Missing -- ^ I am only here because I got into the Intern table
      deriving Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
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 -> Result (Value, ByteString) -> ()
forall a. NFData a => a -> ()
rnf Result (Value, ByteString)
x
        Failed SomeException
x OneShot (Maybe (Result ByteString))
y -> SomeException -> ()
rnfException SomeException
x () -> () -> ()
`seq` OneShot (Maybe (Result ByteString)) -> ()
forall a. NFData a => a -> ()
rnf OneShot (Maybe (Result ByteString))
y
        Loaded Result ByteString
x -> Result ByteString -> ()
forall a. NFData a => a -> ()
rnf Result ByteString
x
        Running NoShow
  (Either SomeException (Result (Value, ByteString)) -> Locked ())
_ OneShot (Maybe (Result ByteString))
x -> OneShot (Maybe (Result ByteString)) -> ()
forall a. NFData a => a -> ()
rnf OneShot (Maybe (Result ByteString))
x -- Can't RNF a waiting, but also unnecessary
        Status
Missing -> ()
        where
            -- best we can do for an arbitrary exception
            rnfException :: SomeException -> ()
rnfException = String -> ()
forall a. NFData a => a -> ()
rnf (String -> ()) -> (SomeException -> String) -> SomeException -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show


data Result a = Result
    {Result a -> a
result :: !a -- ^ the result associated with the Key
    ,Result a -> Step
built :: {-# UNPACK #-} !Step -- ^ when it was actually run
    ,Result a -> Step
changed :: {-# UNPACK #-} !Step -- ^ the step for deciding if it's valid
    ,Result a -> [Depends]
depends :: ![Depends] -- ^ dependencies (don't run them early)
    ,Result a -> Float
execution :: {-# UNPACK #-} !Float -- ^ how long it took when it was last run (seconds)
    ,Result a -> [Trace]
traces :: ![Trace] -- ^ a trace of the expensive operations (start/end in seconds since beginning of run)
    } deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
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,a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
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
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)

instance NFData a => NFData (Result a) where
    -- ignore unpacked fields
    rnf :: Result a -> ()
rnf (Result a
a Step
_ Step
_ [Depends]
b Float
_ [Trace]
c) = a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` [Depends] -> ()
forall a. NFData a => a -> ()
rnf [Depends]
b () -> () -> ()
`seq` [Trace] -> ()
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) = Result (Either ByteString Value)
-> Maybe (Result (Either ByteString Value))
forall a. a -> Maybe a
Just (Result (Either ByteString Value)
 -> Maybe (Result (Either ByteString Value)))
-> Result (Either ByteString Value)
-> Maybe (Result (Either ByteString Value))
forall a b. (a -> b) -> a -> b
$ Value -> Either ByteString Value
forall a b. b -> Either a b
Right (Value -> Either ByteString Value)
-> ((Value, ByteString) -> Value)
-> (Value, ByteString)
-> Either ByteString Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value, ByteString) -> Value
forall a b. (a, b) -> a
fst ((Value, ByteString) -> Either ByteString Value)
-> Result (Value, ByteString) -> Result (Either ByteString Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (Value, ByteString)
r
getResult (Loaded Result ByteString
r) = Result (Either ByteString Value)
-> Maybe (Result (Either ByteString Value))
forall a. a -> Maybe a
Just (Result (Either ByteString Value)
 -> Maybe (Result (Either ByteString Value)))
-> Result (Either ByteString Value)
-> Maybe (Result (Either ByteString Value))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString Value
forall a b. a -> Either a b
Left (ByteString -> Either ByteString Value)
-> Result ByteString -> Result (Either ByteString Value)
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) = (ByteString -> Either ByteString Value)
-> Result ByteString -> Result (Either ByteString Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either ByteString Value
forall a b. a -> Either a b
Left (Result ByteString -> Result (Either ByteString Value))
-> OneShot (Maybe (Result ByteString))
-> Maybe (Result (Either ByteString Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OneShot (Maybe (Result ByteString))
r
getResult Status
_ = Maybe (Result (Either ByteString Value))
forall a. Maybe a
Nothing


---------------------------------------------------------------------
-- OPERATIONS

newtype Depends = Depends {Depends -> [Id]
fromDepends :: [Id]}
    deriving (Depends -> ()
(Depends -> ()) -> NFData Depends
forall a. (a -> ()) -> NFData a
rnf :: Depends -> ()
$crnf :: Depends -> ()
NFData, b -> Depends -> Depends
NonEmpty Depends -> Depends
Depends -> Depends -> Depends
(Depends -> Depends -> Depends)
-> (NonEmpty Depends -> Depends)
-> (forall b. Integral b => b -> Depends -> Depends)
-> Semigroup 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 :: 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
Semigroup Depends
-> Depends
-> (Depends -> Depends -> Depends)
-> ([Depends] -> Depends)
-> Monoid 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
$cp1Monoid :: Semigroup Depends
Monoid)

instance Show Depends where
    -- Appears in diagnostic output and the Depends ctor is just verbose
    show :: Depends -> String
show = [Id] -> String
forall a. Show a => a -> String
show ([Id] -> String) -> (Depends -> [Id]) -> Depends -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Depends -> [Id]
fromDepends

instance BinaryEx Depends where
    putEx :: Depends -> Builder
putEx (Depends [Id]
xs) = [Id] -> Builder
forall a. Storable a => [a] -> Builder
putExStorableList [Id]
xs
    getEx :: ByteString -> Depends
getEx = [Id] -> Depends
Depends ([Id] -> Depends) -> (ByteString -> [Id]) -> ByteString -> Depends
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Id]
forall a. Storable a => ByteString -> [a]
getExStorableList

instance BinaryEx [Depends] where
    putEx :: [Depends] -> Builder
putEx = [Builder] -> Builder
putExList ([Builder] -> Builder)
-> ([Depends] -> [Builder]) -> [Depends] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Depends -> Builder) -> [Depends] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Depends -> Builder
forall a. BinaryEx a => a -> Builder
putEx
    getEx :: ByteString -> [Depends]
getEx = (ByteString -> Depends) -> [ByteString] -> [Depends]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Depends
forall a. BinaryEx a => ByteString -> a
getEx ([ByteString] -> [Depends])
-> (ByteString -> [ByteString]) -> ByteString -> [Depends]
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]

-- Create a new set of depends, from a list in the right order
newDepends :: [Depends] -> DependsList
newDepends :: [Depends] -> DependsList
newDepends = [Depends] -> DependsList
DependsDirect

-- Add two sequences of dependencies in order
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

-- Two goals here, merge parallel lists so they retain as much leading parallelism as possible
-- Afterwards each Id must occur at most once and there are no empty Depends
flattenDepends :: DependsList -> [Depends]
flattenDepends :: DependsList -> [Depends]
flattenDepends DependsList
d = HashSet Id -> [Depends] -> [Depends]
fMany HashSet Id
forall a. HashSet a
Set.empty ([Depends] -> [Depends]) -> [Depends] -> [Depends]
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 [Depends] -> [Depends] -> [Depends]
forall a. [a] -> [a] -> [a]
++ [Depends]
rest
        flat (DependsSequence DependsList
xs DependsList
ys) [Depends]
rest = DependsList -> [Depends] -> [Depends]
flat DependsList
xs ([Depends] -> [Depends]) -> [Depends] -> [Depends]
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 ([Depends] -> [Depends]) -> [Depends] -> [Depends]
forall a b. (a -> b) -> a -> b
$ Depends
yDepends -> [Depends] -> [Depends]
forall a. a -> [a] -> [a]
:[Depends]
rest
        -- for each element of xs, we want to pull off the things that must be done first
        -- and then the stuff that can be done later
        flat (DependsParallel [DependsList]
xs) [Depends]
rest = ([Depends] -> Depends) -> [[Depends]] -> [Depends]
forall a b. (a -> b) -> [a] -> [b]
map [Depends] -> Depends
forall a. Monoid a => [a] -> a
mconcat [[Depends]]
xss [Depends] -> [Depends] -> [Depends]
forall a. [a] -> [a] -> [a]
++ [Depends]
rest
            where xss :: [[Depends]]
xss = [[Depends]] -> [[Depends]]
forall a. [[a]] -> [[a]]
transpose ([[Depends]] -> [[Depends]]) -> [[Depends]] -> [[Depends]]
forall a b. (a -> b) -> a -> b
$ (DependsList -> [Depends]) -> [DependsList] -> [[Depends]]
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 [Id] -> [Id] -> Bool
forall a. Eq a => a -> a -> Bool
/= []] [Depends] -> [Depends] -> [Depends]
forall a. [a] -> [a] -> [a]
++ HashSet Id -> [Depends] -> [Depends]
fMany HashSet Id
seen2 [Depends]
ds
            where ([Id]
d2,HashSet Id
seen2) = HashSet Id -> [Id] -> ([Id], HashSet Id)
forall a.
(Eq 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 a -> HashSet a -> Bool
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) = ([a] -> [a]) -> ([a], HashSet a) -> ([a], HashSet a)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], HashSet a) -> ([a], HashSet a))
-> ([a], HashSet a) -> ([a], HashSet a)
forall a b. (a -> b) -> a -> b
$ HashSet a -> [a] -> ([a], HashSet a)
fOne (a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert a
x HashSet a
seen) [a]
xs




-- List all the dependencies in whatever order you wish, used for linting
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 [Depends] -> [Depends] -> [Depends]
forall a. [a] -> [a] -> [a]
++ [Depends]
rest
        f (DependsSequence DependsList
xs DependsList
ys) [Depends]
rest = DependsList -> [Depends] -> [Depends]
f DependsList
xs ([Depends] -> [Depends]) -> [Depends] -> [Depends]
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
yDepends -> [Depends] -> [Depends]
forall 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 ([Depends] -> [Depends]) -> [Depends] -> [Depends]
forall a b. (a -> b) -> a -> b
$ DependsList -> [Depends] -> [Depends]
f ([DependsList] -> DependsList
DependsParallel [DependsList]
xs) [Depends]
rest


-- | Define a rule between @key@ and @value@. As an example, a typical 'BuiltinRun' will look like:
--
-- > run key oldStore mode = do
-- >     ...
-- >     pure $ RunResult change newStore newValue
--
--   Where you have:
--
-- * @key@, how to identify individual artifacts, e.g. with file names.
--
-- * @oldStore@, the value stored in the database previously, e.g. the file modification time.
--
-- * @mode@, either 'RunDependenciesSame' (none of your dependencies changed, you can probably not rebuild) or
--   'RunDependenciesChanged' (your dependencies changed, probably rebuild).
--
-- * @change@, usually one of either 'ChangedNothing' (no work was required) or 'ChangedRecomputeDiff'
--   (I reran the rule and it should be considered different).
--
-- * @newStore@, the new value to store in the database, which will be passed in next time as @oldStore@.
--
-- * @newValue@, the result that 'Development.Shake.Rule.apply' will return when asked for the given @key@.
type BuiltinRun key value
    = key
    -> Maybe BS.ByteString
    -> RunMode
    -> Action (RunResult value)

-- | The action performed by @--lint@ for a given @key@/@value@ pair.
--   At the end of the build the lint action will be called for each @key@ that was built this run,
--   passing the @value@ it produced. Return 'Nothing' to indicate the value has not changed and
--   is acceptable, or 'Just' an error message to indicate failure.
--
--   For builtin rules where the value is expected to change, or has no useful checks to perform.
--   use 'Development.Shake.Rules.noLint'.
type BuiltinLint key value = key -> value -> IO (Maybe String)


-- | Produce an identity for a @value@ that can be used to do direct equality. If you have a custom
--   notion of equality then the result should return only one member from each equivalence class,
--   as values will be compared for literal equality.
--   The result of the identity should be reasonably short (if it is excessively long, hash it).
--
--   For rules where the value is never compatible use 'Development.Shake.Rules.noIdentity', which
--   returns 'Nothing'. This will disable shared caches of anything that depends on it.
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
    }

-- | A 'UserRule' data type, representing user-defined rules associated with a particular type.
--   As an example 'Development.Shake.?>' and 'Development.Shake.%>' will add entries to the 'UserRule' data type.
data UserRule a
-- > priority p1 (priority p2 x) == priority p1 x
-- > priority p (x `ordered` y) = priority p x `ordered` priority p y
-- > priority p (x `unordered` y) = priority p x `unordered` priority p y
-- > ordered is associative
-- > unordered is associative and commutative
-- > alternative does not obey priorities, until picking the best one
    = UserRule a -- ^ Added to the state with @'addUserRule' :: Typeable a => a -> 'Rules' ()@.
    | Unordered [UserRule a] -- ^ Rules combined with the 'Monad' \/ 'Monoid'.
    | Priority Double (UserRule a) -- ^ Rules defined under 'priority'.
    | Alternative (UserRule a) -- ^ Rule defined under 'alternatives', matched in order.
    | Versioned Ver (UserRule a) -- ^ Rule defined under 'versioned', attaches a version.
      deriving (UserRule a -> UserRule a -> Bool
(UserRule a -> UserRule a -> Bool)
-> (UserRule a -> UserRule a -> Bool) -> Eq (UserRule a)
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
[UserRule a] -> ShowS
UserRule a -> String
(Int -> UserRule a -> ShowS)
-> (UserRule a -> String)
-> ([UserRule a] -> ShowS)
-> Show (UserRule a)
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,a -> UserRule b -> UserRule a
(a -> b) -> UserRule a -> UserRule b
(forall a b. (a -> b) -> UserRule a -> UserRule b)
-> (forall a b. a -> UserRule b -> UserRule a) -> Functor UserRule
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
<$ :: a -> UserRule b -> UserRule a
$c<$ :: forall a b. a -> UserRule b -> UserRule a
fmap :: (a -> b) -> UserRule a -> UserRule b
$cfmap :: forall a b. (a -> b) -> UserRule a -> UserRule b
Functor,Typeable)

data UserRuleVersioned a = UserRuleVersioned
    {UserRuleVersioned a -> Bool
userRuleVersioned :: Bool -- ^ Does Versioned exist anywhere within userRuleContents
    ,UserRuleVersioned a -> UserRule a
userRuleContents :: UserRule a -- ^ The actual rules
    }

instance Semigroup (UserRuleVersioned a) where
    UserRuleVersioned Bool
b1 UserRule a
x1 <> :: UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
<> UserRuleVersioned Bool
b2 UserRule a
x2 = Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned (Bool
b1 Bool -> Bool -> Bool
|| Bool
b2) (UserRule a
x1 UserRule a -> UserRule a -> UserRule a
forall a. Semigroup a => a -> a -> a
<> UserRule a
x2)

instance Monoid (UserRuleVersioned a) where
    mempty :: UserRuleVersioned a
mempty = Bool -> UserRule a -> UserRuleVersioned a
forall a. Bool -> UserRule a -> UserRuleVersioned a
UserRuleVersioned Bool
False UserRule a
forall a. Monoid a => a
mempty
    mappend :: UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
mappend = UserRuleVersioned a -> UserRuleVersioned a -> UserRuleVersioned a
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup (UserRule a) where
    UserRule a
x <> :: UserRule a -> UserRule a -> UserRule a
<> UserRule a
y = [UserRule a] -> UserRule a
forall a. [UserRule a] -> UserRule a
Unordered [UserRule a
x,UserRule a
y]

instance Monoid (UserRule a) where
    mempty :: UserRule a
mempty = [UserRule a] -> UserRule a
forall a. [UserRule a] -> UserRule a
Unordered []
    mappend :: UserRule a -> UserRule a -> UserRule a
mappend = UserRule a -> UserRule a -> UserRule a
forall a. Semigroup a => a -> a -> a
(<>)

userRuleSize :: UserRule a -> Int
userRuleSize :: UserRule a -> Int
userRuleSize UserRule{} = Int
1
userRuleSize (Unordered [UserRule a]
xs) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (UserRule a -> Int) -> [UserRule a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize [UserRule a]
xs
userRuleSize (Priority Seconds
_ UserRule a
x) = UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize UserRule a
x
userRuleSize (Alternative UserRule a
x) = UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize UserRule a
x
userRuleSize (Versioned Ver
_ UserRule a
x) = UserRule a -> Int
forall a. UserRule a -> Int
userRuleSize UserRule a
x


type Database = DatabasePoly Key Status

-- global constants of Action
data Global = Global
    {Global -> [String] -> [Key] -> Action [Value]
globalBuild :: [String] -> [Key] -> Action [Value]
    ,Global -> Database
globalDatabase :: Database -- ^ Database, contains knowledge of the state of each key
    ,Global -> Pool
globalPool :: Pool -- ^ Pool, for queuing new elements
    ,Global -> Cleanup
globalCleanup :: Cleanup -- ^ Cleanup operations
    ,Global -> IO Seconds
globalTimestamp :: IO Seconds -- ^ Clock saying how many seconds through the build
    ,Global -> HashMap TypeRep BuiltinRule
globalRules :: Map.HashMap TypeRep BuiltinRule -- ^ Rules for this build
    ,Global -> Verbosity -> String -> IO ()
globalOutput :: Verbosity -> String -> IO () -- ^ Output function
    ,Global -> ShakeOptions
globalOptions  :: ShakeOptions -- ^ Shake options
    ,Global -> IO String -> IO ()
globalDiagnostic :: IO String -> IO () -- ^ Debugging function
    ,Global -> Key -> Action ()
globalRuleFinished :: Key -> Action () -- ^ actions to run after each rule
    ,Global -> IORef [IO ()]
globalAfter :: IORef [IO ()] -- ^ Operations to run on success, e.g. removeFilesAfter
    ,Global -> IORef [(Key, Key)]
globalTrackAbsent :: IORef [(Key, Key)] -- ^ Tracked things, in rule fst, snd must be absent
    ,Global -> IO Progress
globalProgress :: IO Progress -- ^ Request current progress state
    ,Global -> Map UserRuleVersioned
globalUserRules :: TMap.Map UserRuleVersioned
    ,Global -> Maybe Shared
globalShared :: Maybe Shared -- ^ The active shared state, if any
    ,Global -> Maybe Cloud
globalCloud :: Maybe Cloud
    ,Global -> Step
globalStep :: {-# UNPACK #-} !Step
    ,Global -> Bool
globalOneShot :: Bool -- ^ I am running in one-shot mode so don't need to store BS's for Result/Failed
    }

-- local variables of Action
data Local = Local
    -- constants
    {Local -> Stack
localStack :: Stack -- ^ The stack that ran to get here.
    ,Local -> Ver
localBuiltinVersion :: Ver -- ^ The builtinVersion of the rule you are running
    -- stack scoped local variables
    ,Local -> Verbosity
localVerbosity :: Verbosity -- ^ Verbosity, may be changed locally
    ,Local -> Maybe String
localBlockApply ::  Maybe String -- ^ Reason to block apply, or Nothing to allow
    -- mutable local variables
    ,Local -> DependsList
localDepends :: DependsList -- ^ Dependencies that we rely on, morally a list of sets
    ,Local -> Seconds
localDiscount :: !Seconds -- ^ Time spend building dependencies (may be negative for parallel)
    ,Local -> Traces
localTraces :: Traces -- ^ Traces that have occurred
    ,Local -> [Key -> Bool]
localTrackAllows :: [Key -> Bool] -- ^ Things that are allowed to be used
    ,Local -> [Key]
localTrackRead :: [Key] -- ^ Calls to 'lintTrackRead'
    ,Local -> [Key]
localTrackWrite :: [Key] -- ^ Calls to 'lintTrackWrite'
    ,Local -> [(Bool, String)]
localProduces :: [(Bool, FilePath)] -- ^ Things this rule produces, True to check them
    ,Local -> Bool
localHistory :: !Bool -- ^ Is it valid to cache the result
    }

data Traces
    = TracesNone -- no traces
    | TracesSequence1 Traces Trace -- Like TracesSequence but with 1 element
    | TracesSequence Traces Traces -- first the Traces happened, then Traces that happened after
    | TracesParallel [Traces] -- these traces happened in parallel with each other

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
bTrace -> [Trace] -> [Trace]
forall a. a -> [a] -> [a]
:[Trace]
rest)
        f (TracesSequence Traces
a Traces
b) [Trace]
rest = Traces -> [Trace] -> [Trace]
f Traces
a ([Trace] -> [Trace]) -> [Trace] -> [Trace]
forall a b. (a -> b) -> a -> b
$ Traces -> [Trace] -> [Trace]
f Traces
b [Trace]
rest
        f (TracesParallel []) [Trace]
rest = [Trace]
rest
        -- Might want to resort them by time started?
        f (TracesParallel (Traces
x:[Traces]
xs)) [Trace]
rest = Traces -> [Trace] -> [Trace]
f Traces
x ([Trace] -> [Trace]) -> [Trace] -> [Trace]
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 Seconds -> Seconds -> Seconds
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 Maybe String
forall a. Maybe a
Nothing DependsList
DependsNone Seconds
0 Traces
TracesNone [] [] [] [] Bool
True

-- Clear all the local mutable variables
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}

-- Merge, works well assuming you clear the variables first with localClearMutable.
-- Assume the first was run sequentially, and the list in parallel.
localMergeMutable :: Local -> [Local] -> Local
-- don't construct with RecordWildCards so any new fields raise an error
localMergeMutable :: Local -> [Local] -> Local
localMergeMutable Local
root [Local]
xs = Local :: Stack
-> Ver
-> Verbosity
-> Maybe String
-> DependsList
-> Seconds
-> Traces
-> [Key -> Bool]
-> [Key]
-> [Key]
-> [(Bool, String)]
-> Bool
-> Local
Local
    -- immutable/stack that need copying
    {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
    -- mutable locals that need integrating
    -- note that a lot of the lists are stored in reverse, assume root happened first
    ,localDepends :: DependsList
localDepends = [DependsList] -> DependsList
DependsParallel ((Local -> DependsList) -> [Local] -> [DependsList]
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 = [Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Seconds] -> Seconds) -> [Seconds] -> Seconds
forall a b. (a -> b) -> a -> b
$ (Local -> Seconds) -> [Local] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map Local -> Seconds
localDiscount ([Local] -> [Seconds]) -> [Local] -> [Seconds]
forall a b. (a -> b) -> a -> b
$ Local
root Local -> [Local] -> [Local]
forall a. a -> [a] -> [a]
: [Local]
xs
    ,localTraces :: Traces
localTraces = [Traces] -> Traces
TracesParallel ((Local -> Traces) -> [Local] -> [Traces]
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 [Key -> Bool] -> [Key -> Bool] -> [Key -> Bool]
forall a. [a] -> [a] -> [a]
++ (Local -> [Key -> Bool]) -> [Local] -> [Key -> Bool]
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 [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (Local -> [Key]) -> [Local] -> [Key]
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 [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (Local -> [Key]) -> [Local] -> [Key]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Key]
localTrackWrite [Local]
xs
    ,localProduces :: [(Bool, String)]
localProduces = (Local -> [(Bool, String)]) -> [Local] -> [(Bool, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [(Bool, String)]
localProduces [Local]
xs [(Bool, String)] -> [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a] -> [a]
++ Local -> [(Bool, String)]
localProduces Local
root
    ,localHistory :: Bool
localHistory = (Local -> Bool) -> [Local] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Local -> Bool
localHistory ([Local] -> Bool) -> [Local] -> Bool
forall a b. (a -> b) -> a -> b
$ Local
rootLocal -> [Local] -> [Local]
forall a. a -> [a] -> [a]
:[Local]
xs
    }