{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification, DeriveFunctor, RecordWildCards #-}
module Development.Shake.Internal.Core.Types(
BuiltinRun, BuiltinLint, RunResult(..), RunChanged(..),
UserRule(..), UserRule_(..),
BuiltinRule(..), Global(..), Local(..), Action(..),
newLocal, localClearMutable, localMergeMutable
) where
import Control.DeepSeq
import Control.Monad.IO.Class
import Control.Applicative
import Data.Typeable
import General.Binary
import qualified Data.HashMap.Strict as Map
import Data.IORef
import qualified Data.ByteString as BS
import System.Time.Extra
import Development.Shake.Internal.Core.Pool
import Development.Shake.Internal.Core.Database
import Development.Shake.Internal.Core.Monad
import Development.Shake.Internal.Value
import Development.Shake.Internal.Options
import General.Cleanup
import Prelude
#if __GLASGOW_HASKELL__ >= 800
import Control.Monad.Fail
#endif
newtype Action a = Action {Action a -> RAW Global Local a
fromAction :: RAW 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
#if __GLASGOW_HASKELL__ >= 800
,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
#endif
)
data RunChanged
= ChangedNothing
| ChangedStore
| ChangedRecomputeSame
| ChangedRecomputeDiff
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 x :: RunChanged
x = RunChanged
x RunChanged -> () -> ()
forall a b. a -> b -> b
`seq` ()
data RunResult value = RunResult
{RunResult value -> RunChanged
runChanged :: RunChanged
,RunResult value -> ByteString
runStore :: BS.ByteString
,RunResult value -> value
runValue :: value
} 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 x1 :: RunChanged
x1 x2 :: ByteString
x2 x3 :: value
x3) = RunChanged -> ()
forall a. NFData a => a -> ()
rnf RunChanged
x1 () -> () -> ()
forall a b. a -> b -> b
`seq` ByteString
x2 ByteString -> () -> ()
forall a b. a -> b -> b
`seq` value -> ()
forall a. NFData a => a -> ()
rnf value
x3
type BuiltinRun key value
= key
-> Maybe BS.ByteString
-> Bool
-> Action (RunResult value)
type BuiltinLint key value = key -> value -> IO (Maybe String)
data BuiltinRule = BuiltinRule
{BuiltinRule -> BuiltinRun Key Value
builtinRun :: BuiltinRun Key Value
,BuiltinRule -> BuiltinLint Key Value
builtinLint :: BuiltinLint Key Value
,BuiltinRule -> TypeRep
builtinResult :: TypeRep
,BuiltinRule -> BinaryOp Key
builtinKey :: BinaryOp Key
}
data UserRule_ = forall a . Typeable a => UserRule_ (UserRule a)
data UserRule a
= UserRule a
| Unordered [UserRule a]
| Priority Double (UserRule a)
| Alternative (UserRule a)
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 Global = Global
{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 -> String
globalCurDir :: FilePath
,Global -> IORef [IO ()]
globalAfter :: IORef [IO ()]
,Global -> IORef [(Key, Key)]
globalTrackAbsent :: IORef [(Key, Key)]
,Global -> IO Progress
globalProgress :: IO Progress
,Global -> HashMap TypeRep UserRule_
globalUserRules :: Map.HashMap TypeRep UserRule_
}
data Local = Local
{Local -> Stack
localStack :: Stack
,Local -> Verbosity
localVerbosity :: Verbosity
,Local -> Maybe String
localBlockApply :: Maybe String
,Local -> [Depends]
localDepends :: [Depends]
,Local -> Seconds
localDiscount :: !Seconds
,Local -> [Trace]
localTraces :: [Trace]
,Local -> [Key -> Bool]
localTrackAllows :: [Key -> Bool]
,Local -> [Key]
localTrackUsed :: [Key]
}
newLocal :: Stack -> Verbosity -> Local
newLocal :: Stack -> Verbosity -> Local
newLocal stack :: Stack
stack verb :: Verbosity
verb = Stack
-> Verbosity
-> Maybe String
-> [Depends]
-> Seconds
-> [Trace]
-> [Key -> Bool]
-> [Key]
-> Local
Local Stack
stack Verbosity
verb Maybe String
forall a. Maybe a
Nothing [] 0 [] [] []
localClearMutable :: Local -> Local
localClearMutable :: Local -> Local
localClearMutable Local{..} = (Stack -> Verbosity -> Local
newLocal Stack
localStack Verbosity
localVerbosity){localBlockApply :: Maybe String
localBlockApply=Maybe String
localBlockApply}
localMergeMutable :: Local -> [Local] -> Local
localMergeMutable :: Local -> [Local] -> Local
localMergeMutable root :: Local
root xs :: [Local]
xs = $WLocal :: Stack
-> Verbosity
-> Maybe String
-> [Depends]
-> Seconds
-> [Trace]
-> [Key -> Bool]
-> [Key]
-> Local
Local
{localStack :: Stack
localStack = Local -> Stack
localStack Local
root
,localVerbosity :: Verbosity
localVerbosity = Local -> Verbosity
localVerbosity Local
root
,localBlockApply :: Maybe String
localBlockApply = Local -> Maybe String
localBlockApply Local
root
,localDepends :: [Depends]
localDepends = (Local -> [Depends]) -> [Local] -> [Depends]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Depends]
localDepends [Local]
xs [Depends] -> [Depends] -> [Depends]
forall a. [a] -> [a] -> [a]
++ Local -> [Depends]
localDepends Local
root
,localDiscount :: Seconds
localDiscount = Local -> Seconds
localDiscount Local
root Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
+ [Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0Seconds -> [Seconds] -> [Seconds]
forall a. a -> [a] -> [a]
:(Local -> Seconds) -> [Local] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map Local -> Seconds
localDiscount [Local]
xs)
,localTraces :: [Trace]
localTraces = (Local -> [Trace]) -> [Local] -> [Trace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Local -> [Trace]
localTraces [Local]
xs [Trace] -> [Trace] -> [Trace]
forall a. [a] -> [a] -> [a]
++ Local -> [Trace]
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
,localTrackUsed :: [Key]
localTrackUsed = Local -> [Key]
localTrackUsed 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]
localTrackUsed [Local]
xs
}