{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}
module Development.IDE.Graph.Internal.Types where
import Control.Concurrent.STM (STM)
import Control.Monad ((>=>))
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (second)
import qualified Data.ByteString as BS
import Data.Dynamic
import Data.Foldable (fold)
import qualified Data.HashMap.Strict as Map
import Data.IORef
import Data.List (intercalate)
import Data.Maybe
import Data.Typeable
import Development.IDE.Graph.Classes
import Development.IDE.Graph.Internal.Key
import GHC.Conc (TVar, atomically)
import GHC.Generics (Generic)
import qualified ListT
import qualified StmContainers.Map as SMap
import StmContainers.Map (Map)
import System.Time.Extra (Seconds)
import UnliftIO (MonadUnliftIO)
#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
unwrapDynamic :: forall a . Typeable a => Dynamic -> a
unwrapDynamic :: forall a. Typeable a => Dynamic -> a
unwrapDynamic Dynamic
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
msg) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
x
where msg :: [Char]
msg = [Char]
"unwrapDynamic failed: Expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
", but got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Dynamic -> TypeRep
dynTypeRep Dynamic
x)
type TheRules = Map.HashMap TypeRep Dynamic
newtype Rules a = Rules (ReaderT SRules IO a)
deriving newtype (Applicative Rules
Applicative Rules =>
(forall a b. Rules a -> (a -> Rules b) -> Rules b)
-> (forall a b. Rules a -> Rules b -> Rules b)
-> (forall a. a -> Rules a)
-> Monad Rules
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules a -> (a -> Rules b) -> Rules 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
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>> :: forall a b. Rules a -> Rules b -> Rules b
$creturn :: forall a. a -> Rules a
return :: forall a. a -> Rules a
Monad, Functor Rules
Functor Rules =>
(forall a. a -> Rules a)
-> (forall a b. Rules (a -> b) -> Rules a -> Rules b)
-> (forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c)
-> (forall a b. Rules a -> Rules b -> Rules b)
-> (forall a b. Rules a -> Rules b -> Rules a)
-> Applicative Rules
forall a. a -> Rules a
forall a b. Rules a -> Rules b -> Rules a
forall a b. Rules a -> Rules b -> Rules b
forall a b. Rules (a -> b) -> Rules a -> Rules b
forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules 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
$cpure :: forall a. a -> Rules a
pure :: forall a. a -> Rules a
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
liftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
$c*> :: forall a b. Rules a -> Rules b -> Rules b
*> :: forall a b. Rules a -> Rules b -> Rules b
$c<* :: forall a b. Rules a -> Rules b -> Rules a
<* :: forall a b. Rules a -> Rules b -> Rules a
Applicative, (forall a b. (a -> b) -> Rules a -> Rules b)
-> (forall a b. a -> Rules b -> Rules a) -> Functor Rules
forall a b. a -> Rules b -> Rules a
forall a b. (a -> b) -> Rules a -> Rules b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
fmap :: forall a b. (a -> b) -> Rules a -> Rules b
$c<$ :: forall a b. a -> Rules b -> Rules a
<$ :: forall a b. a -> Rules b -> Rules a
Functor, Monad Rules
Monad Rules => (forall a. IO a -> Rules a) -> MonadIO Rules
forall a. IO a -> Rules a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Rules a
liftIO :: forall a. IO a -> Rules a
MonadIO)
data SRules = SRules {
:: !Dynamic,
SRules -> IORef [Action ()]
rulesActions :: !(IORef [Action ()]),
SRules -> IORef TheRules
rulesMap :: !(IORef TheRules)
}
newtype Action a = Action {forall a. Action a -> ReaderT SAction IO a
fromAction :: ReaderT SAction IO a}
deriving newtype (Applicative Action
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
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
$c>>= :: forall a b. Action a -> (a -> Action b) -> Action b
>>= :: forall a b. Action a -> (a -> Action b) -> Action b
$c>> :: forall a b. Action a -> Action b -> Action b
>> :: forall a b. Action a -> Action b -> Action b
$creturn :: forall a. a -> Action a
return :: forall a. a -> Action a
Monad, Functor Action
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
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
$cpure :: forall a. a -> Action a
pure :: forall a. a -> Action a
$c<*> :: forall a b. Action (a -> b) -> Action a -> Action b
<*> :: forall a b. Action (a -> b) -> Action a -> Action b
$cliftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
liftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
$c*> :: forall a b. Action a -> Action b -> Action b
*> :: forall a b. Action a -> Action b -> Action b
$c<* :: forall a b. Action a -> Action b -> Action a
<* :: forall a b. Action a -> Action b -> Action a
Applicative, (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
$cfmap :: forall a b. (a -> b) -> Action a -> Action b
fmap :: forall a b. (a -> b) -> Action a -> Action b
$c<$ :: forall a b. a -> Action b -> Action a
<$ :: forall a b. a -> Action b -> Action a
Functor, Monad Action
Monad Action => (forall a. IO a -> Action a) -> MonadIO Action
forall a. IO a -> Action a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Action a
liftIO :: forall a. IO a -> Action a
MonadIO, Monad Action
Monad Action => (forall a. [Char] -> Action a) -> MonadFail Action
forall a. [Char] -> Action a
forall (m :: * -> *).
Monad m =>
(forall a. [Char] -> m a) -> MonadFail m
$cfail :: forall a. [Char] -> Action a
fail :: forall a. [Char] -> Action a
MonadFail, Monad Action
Monad Action =>
(forall e a. (HasCallStack, Exception e) => e -> Action a)
-> MonadThrow Action
forall e a. (HasCallStack, Exception e) => e -> Action a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Action a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Action a
MonadThrow, MonadThrow Action
MonadThrow Action =>
(forall e a.
(HasCallStack, Exception e) =>
Action a -> (e -> Action a) -> Action a)
-> MonadCatch Action
forall e a.
(HasCallStack, Exception e) =>
Action a -> (e -> Action a) -> Action a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
Action a -> (e -> Action a) -> Action a
catch :: forall e a.
(HasCallStack, Exception e) =>
Action a -> (e -> Action a) -> Action a
MonadCatch, MonadCatch Action
MonadCatch Action =>
(forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b)
-> (forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b)
-> (forall a b c.
HasCallStack =>
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c))
-> MonadMask Action
forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b
forall a b c.
HasCallStack =>
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
HasCallStack =>
((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b
mask :: forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Action a -> Action a) -> Action b) -> Action b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
MonadMask, MonadIO Action
MonadIO Action =>
(forall b. ((forall a. Action a -> IO a) -> IO b) -> Action b)
-> MonadUnliftIO Action
forall b. ((forall a. Action a -> IO a) -> IO b) -> Action b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. Action a -> IO a) -> IO b) -> Action b
withRunInIO :: forall b. ((forall a. Action a -> IO a) -> IO b) -> Action b
MonadUnliftIO)
data SAction = SAction {
SAction -> Database
actionDatabase :: !Database,
SAction -> IORef ResultDeps
actionDeps :: !(IORef ResultDeps),
SAction -> Stack
actionStack :: !Stack
}
getDatabase :: Action Database
getDatabase :: Action Database
getDatabase = ReaderT SAction IO Database -> Action Database
forall a. ReaderT SAction IO a -> Action a
Action (ReaderT SAction IO Database -> Action Database)
-> ReaderT SAction IO Database -> Action Database
forall a b. (a -> b) -> a -> b
$ (SAction -> Database) -> ReaderT SAction IO Database
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SAction -> Database
actionDatabase
waitForDatabaseRunningKeysAction :: Action ()
waitForDatabaseRunningKeysAction :: Action ()
waitForDatabaseRunningKeysAction = Action Database
getDatabase Action Database -> (Database -> Action ()) -> Action ()
forall a b. Action a -> (a -> Action b) -> Action b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ())
-> (Database -> IO ()) -> Database -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> IO ()
waitForDatabaseRunningKeys
data ShakeDatabase = ShakeDatabase !Int [Action ()] Database
newtype Step = Step Int
deriving newtype (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
/= :: 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
$ccompare :: Step -> Step -> Ordering
compare :: Step -> Step -> Ordering
$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
>= :: Step -> Step -> Bool
$cmax :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
min :: Step -> Step -> Step
Ord,Eq Step
Eq Step => (Int -> Step -> Int) -> (Step -> Int) -> Hashable Step
Int -> Step -> Int
Step -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Step -> Int
hashWithSalt :: Int -> Step -> Int
$chash :: Step -> Int
hash :: Step -> Int
Hashable,Int -> Step -> [Char] -> [Char]
[Step] -> [Char] -> [Char]
Step -> [Char]
(Int -> Step -> [Char] -> [Char])
-> (Step -> [Char]) -> ([Step] -> [Char] -> [Char]) -> Show Step
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Step -> [Char] -> [Char]
showsPrec :: Int -> Step -> [Char] -> [Char]
$cshow :: Step -> [Char]
show :: Step -> [Char]
$cshowList :: [Step] -> [Char] -> [Char]
showList :: [Step] -> [Char] -> [Char]
Show)
newtype Value = Value Dynamic
data KeyDetails = KeyDetails {
KeyDetails -> Status
keyStatus :: !Status,
KeyDetails -> KeySet
keyReverseDeps :: !KeySet
}
onKeyReverseDeps :: (KeySet -> KeySet) -> KeyDetails -> KeyDetails
onKeyReverseDeps :: (KeySet -> KeySet) -> KeyDetails -> KeyDetails
onKeyReverseDeps KeySet -> KeySet
f it :: KeyDetails
it@KeyDetails{KeySet
Status
keyStatus :: KeyDetails -> Status
keyReverseDeps :: KeyDetails -> KeySet
keyStatus :: Status
keyReverseDeps :: KeySet
..} =
KeyDetails
it{keyReverseDeps = f keyReverseDeps}
data Database = Database {
:: Dynamic,
Database -> TheRules
databaseRules :: TheRules,
Database -> TVar Step
databaseStep :: !(TVar Step),
Database -> Map Key KeyDetails
databaseValues :: !(Map Key KeyDetails)
}
waitForDatabaseRunningKeys :: Database -> IO ()
waitForDatabaseRunningKeys :: Database -> IO ()
waitForDatabaseRunningKeys = Database -> IO [(Key, Status)]
getDatabaseValues (Database -> IO [(Key, Status)])
-> ([(Key, Status)] -> IO ()) -> Database -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ((Key, Status) -> IO ()) -> [(Key, Status)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Status -> IO ()
waitRunning (Status -> IO ())
-> ((Key, Status) -> Status) -> (Key, Status) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Status) -> Status
forall a b. (a, b) -> b
snd)
getDatabaseValues :: Database -> IO [(Key, Status)]
getDatabaseValues :: Database -> IO [(Key, Status)]
getDatabaseValues = STM [(Key, Status)] -> IO [(Key, Status)]
forall a. STM a -> IO a
atomically
(STM [(Key, Status)] -> IO [(Key, Status)])
-> (Database -> STM [(Key, Status)])
-> Database
-> IO [(Key, Status)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Key, KeyDetails)] -> [(Key, Status)])
-> STM [(Key, KeyDetails)] -> STM [(Key, Status)]
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(([(Key, KeyDetails)] -> [(Key, Status)])
-> STM [(Key, KeyDetails)] -> STM [(Key, Status)])
-> (((Key, KeyDetails) -> (Key, Status))
-> [(Key, KeyDetails)] -> [(Key, Status)])
-> ((Key, KeyDetails) -> (Key, Status))
-> STM [(Key, KeyDetails)]
-> STM [(Key, Status)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Key, KeyDetails) -> (Key, Status))
-> [(Key, KeyDetails)] -> [(Key, Status)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((KeyDetails -> Status) -> (Key, KeyDetails) -> (Key, Status)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second KeyDetails -> Status
keyStatus)
(STM [(Key, KeyDetails)] -> STM [(Key, Status)])
-> (Database -> STM [(Key, KeyDetails)])
-> Database
-> STM [(Key, Status)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT STM (Key, KeyDetails) -> STM [(Key, KeyDetails)]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList
(ListT STM (Key, KeyDetails) -> STM [(Key, KeyDetails)])
-> (Database -> ListT STM (Key, KeyDetails))
-> Database
-> STM [(Key, KeyDetails)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Key KeyDetails -> ListT STM (Key, KeyDetails)
forall key value. Map key value -> ListT STM (key, value)
SMap.listT
(Map Key KeyDetails -> ListT STM (Key, KeyDetails))
-> (Database -> Map Key KeyDetails)
-> Database
-> ListT STM (Key, KeyDetails)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> Map Key KeyDetails
databaseValues
data Status
= Clean !Result
| Dirty (Maybe Result)
| Running {
Status -> Step
runningStep :: !Step,
Status -> IO ()
runningWait :: !(IO ()),
Status -> Result
runningResult :: Result,
Status -> Maybe Result
runningPrev :: !(Maybe Result)
}
viewDirty :: Step -> Status -> Status
viewDirty :: Step -> Status -> Status
viewDirty Step
currentStep (Running Step
s IO ()
_ Result
_ Maybe Result
re) | Step
currentStep Step -> Step -> Bool
forall a. Eq a => a -> a -> Bool
/= Step
s = Maybe Result -> Status
Dirty Maybe Result
re
viewDirty Step
_ Status
other = Status
other
getResult :: Status -> Maybe Result
getResult :: Status -> Maybe Result
getResult (Clean Result
re) = Result -> Maybe Result
forall a. a -> Maybe a
Just Result
re
getResult (Dirty Maybe Result
m_re) = Maybe Result
m_re
getResult (Running Step
_ IO ()
_ Result
_ Maybe Result
m_re) = Maybe Result
m_re
waitRunning :: Status -> IO ()
waitRunning :: Status -> IO ()
waitRunning Running{Maybe Result
IO ()
Result
Step
runningStep :: Status -> Step
runningWait :: Status -> IO ()
runningResult :: Status -> Result
runningPrev :: Status -> Maybe Result
runningStep :: Step
runningWait :: IO ()
runningResult :: Result
runningPrev :: Maybe Result
..} = IO ()
runningWait
waitRunning Status
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data Result = Result {
Result -> Value
resultValue :: !Value,
Result -> Step
resultBuilt :: !Step,
Result -> Step
resultChanged :: !Step,
Result -> Step
resultVisited :: !Step,
Result -> ResultDeps
resultDeps :: !ResultDeps,
Result -> Seconds
resultExecution :: !Seconds,
Result -> ByteString
resultData :: !BS.ByteString
}
data ResultDeps = UnknownDeps | AlwaysRerunDeps !KeySet | ResultDeps ![KeySet]
deriving (ResultDeps -> ResultDeps -> Bool
(ResultDeps -> ResultDeps -> Bool)
-> (ResultDeps -> ResultDeps -> Bool) -> Eq ResultDeps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResultDeps -> ResultDeps -> Bool
== :: ResultDeps -> ResultDeps -> Bool
$c/= :: ResultDeps -> ResultDeps -> Bool
/= :: ResultDeps -> ResultDeps -> Bool
Eq, Int -> ResultDeps -> [Char] -> [Char]
[ResultDeps] -> [Char] -> [Char]
ResultDeps -> [Char]
(Int -> ResultDeps -> [Char] -> [Char])
-> (ResultDeps -> [Char])
-> ([ResultDeps] -> [Char] -> [Char])
-> Show ResultDeps
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ResultDeps -> [Char] -> [Char]
showsPrec :: Int -> ResultDeps -> [Char] -> [Char]
$cshow :: ResultDeps -> [Char]
show :: ResultDeps -> [Char]
$cshowList :: [ResultDeps] -> [Char] -> [Char]
showList :: [ResultDeps] -> [Char] -> [Char]
Show)
getResultDepsDefault :: KeySet -> ResultDeps -> KeySet
getResultDepsDefault :: KeySet -> ResultDeps -> KeySet
getResultDepsDefault KeySet
_ (ResultDeps [KeySet]
ids) = [KeySet] -> KeySet
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [KeySet]
ids
getResultDepsDefault KeySet
_ (AlwaysRerunDeps KeySet
ids) = KeySet
ids
getResultDepsDefault KeySet
def ResultDeps
UnknownDeps = KeySet
def
mapResultDeps :: (KeySet -> KeySet) -> ResultDeps -> ResultDeps
mapResultDeps :: (KeySet -> KeySet) -> ResultDeps -> ResultDeps
mapResultDeps KeySet -> KeySet
f (ResultDeps [KeySet]
ids) = [KeySet] -> ResultDeps
ResultDeps ([KeySet] -> ResultDeps) -> [KeySet] -> ResultDeps
forall a b. (a -> b) -> a -> b
$ (KeySet -> KeySet) -> [KeySet] -> [KeySet]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeySet -> KeySet
f [KeySet]
ids
mapResultDeps KeySet -> KeySet
f (AlwaysRerunDeps KeySet
ids) = KeySet -> ResultDeps
AlwaysRerunDeps (KeySet -> ResultDeps) -> KeySet -> ResultDeps
forall a b. (a -> b) -> a -> b
$ KeySet -> KeySet
f KeySet
ids
mapResultDeps KeySet -> KeySet
_ ResultDeps
UnknownDeps = ResultDeps
UnknownDeps
instance Semigroup ResultDeps where
ResultDeps
UnknownDeps <> :: ResultDeps -> ResultDeps -> ResultDeps
<> ResultDeps
x = ResultDeps
x
ResultDeps
x <> ResultDeps
UnknownDeps = ResultDeps
x
AlwaysRerunDeps KeySet
ids <> ResultDeps
x = KeySet -> ResultDeps
AlwaysRerunDeps (KeySet
ids KeySet -> KeySet -> KeySet
forall a. Semigroup a => a -> a -> a
<> KeySet -> ResultDeps -> KeySet
getResultDepsDefault KeySet
forall a. Monoid a => a
mempty ResultDeps
x)
ResultDeps
x <> AlwaysRerunDeps KeySet
ids = KeySet -> ResultDeps
AlwaysRerunDeps (KeySet -> ResultDeps -> KeySet
getResultDepsDefault KeySet
forall a. Monoid a => a
mempty ResultDeps
x KeySet -> KeySet -> KeySet
forall a. Semigroup a => a -> a -> a
<> KeySet
ids)
ResultDeps [KeySet]
ids <> ResultDeps [KeySet]
ids' = [KeySet] -> ResultDeps
ResultDeps ([KeySet]
ids [KeySet] -> [KeySet] -> [KeySet]
forall a. Semigroup a => a -> a -> a
<> [KeySet]
ids')
instance Monoid ResultDeps where
mempty :: ResultDeps
mempty = ResultDeps
UnknownDeps
data RunMode
= RunDependenciesSame
| RunDependenciesChanged
deriving (RunMode -> RunMode -> Bool
(RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool) -> Eq RunMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunMode -> RunMode -> Bool
== :: RunMode -> RunMode -> Bool
$c/= :: RunMode -> RunMode -> Bool
/= :: RunMode -> RunMode -> Bool
Eq,Int -> RunMode -> [Char] -> [Char]
[RunMode] -> [Char] -> [Char]
RunMode -> [Char]
(Int -> RunMode -> [Char] -> [Char])
-> (RunMode -> [Char])
-> ([RunMode] -> [Char] -> [Char])
-> Show RunMode
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RunMode -> [Char] -> [Char]
showsPrec :: Int -> RunMode -> [Char] -> [Char]
$cshow :: RunMode -> [Char]
show :: RunMode -> [Char]
$cshowList :: [RunMode] -> [Char] -> [Char]
showList :: [RunMode] -> [Char] -> [Char]
Show)
instance NFData RunMode where rnf :: RunMode -> ()
rnf RunMode
x = RunMode
x RunMode -> () -> ()
forall a b. a -> b -> b
`seq` ()
data RunChanged
= ChangedNothing
| ChangedRecomputeSame
| ChangedRecomputeDiff
deriving (RunChanged -> RunChanged -> Bool
(RunChanged -> RunChanged -> Bool)
-> (RunChanged -> RunChanged -> Bool) -> Eq RunChanged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunChanged -> RunChanged -> Bool
== :: RunChanged -> RunChanged -> Bool
$c/= :: RunChanged -> RunChanged -> Bool
/= :: RunChanged -> RunChanged -> Bool
Eq,Int -> RunChanged -> [Char] -> [Char]
[RunChanged] -> [Char] -> [Char]
RunChanged -> [Char]
(Int -> RunChanged -> [Char] -> [Char])
-> (RunChanged -> [Char])
-> ([RunChanged] -> [Char] -> [Char])
-> Show RunChanged
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RunChanged -> [Char] -> [Char]
showsPrec :: Int -> RunChanged -> [Char] -> [Char]
$cshow :: RunChanged -> [Char]
show :: RunChanged -> [Char]
$cshowList :: [RunChanged] -> [Char] -> [Char]
showList :: [RunChanged] -> [Char] -> [Char]
Show,(forall x. RunChanged -> Rep RunChanged x)
-> (forall x. Rep RunChanged x -> RunChanged) -> Generic RunChanged
forall x. Rep RunChanged x -> RunChanged
forall x. RunChanged -> Rep RunChanged x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunChanged -> Rep RunChanged x
from :: forall x. RunChanged -> Rep RunChanged x
$cto :: forall x. Rep RunChanged x -> RunChanged
to :: forall x. Rep RunChanged x -> RunChanged
Generic)
deriving anyclass (Maybe RunChanged
Value -> Parser [RunChanged]
Value -> Parser RunChanged
(Value -> Parser RunChanged)
-> (Value -> Parser [RunChanged])
-> Maybe RunChanged
-> FromJSON RunChanged
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunChanged
parseJSON :: Value -> Parser RunChanged
$cparseJSONList :: Value -> Parser [RunChanged]
parseJSONList :: Value -> Parser [RunChanged]
$comittedField :: Maybe RunChanged
omittedField :: Maybe RunChanged
FromJSON, [RunChanged] -> Value
[RunChanged] -> Encoding
RunChanged -> Bool
RunChanged -> Value
RunChanged -> Encoding
(RunChanged -> Value)
-> (RunChanged -> Encoding)
-> ([RunChanged] -> Value)
-> ([RunChanged] -> Encoding)
-> (RunChanged -> Bool)
-> ToJSON RunChanged
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunChanged -> Value
toJSON :: RunChanged -> Value
$ctoEncoding :: RunChanged -> Encoding
toEncoding :: RunChanged -> Encoding
$ctoJSONList :: [RunChanged] -> Value
toJSONList :: [RunChanged] -> Value
$ctoEncodingList :: [RunChanged] -> Encoding
toEncodingList :: [RunChanged] -> Encoding
$comitField :: RunChanged -> Bool
omitField :: RunChanged -> Bool
ToJSON)
instance NFData RunChanged where rnf :: RunChanged -> ()
rnf RunChanged
x = RunChanged
x RunChanged -> () -> ()
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
,forall value. RunResult value -> STM ()
runHook :: STM ()
} deriving (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
$cfmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
fmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
$c<$ :: forall a b. a -> RunResult b -> RunResult a
<$ :: forall a b. a -> RunResult b -> RunResult a
Functor
data GraphException = forall e. Exception e => GraphException {
GraphException -> [Char]
target :: String,
GraphException -> [[Char]]
stack :: [String],
()
inner :: e
}
deriving (Typeable, Show GraphException
Typeable GraphException
(Typeable GraphException, Show GraphException) =>
(GraphException -> SomeException)
-> (SomeException -> Maybe GraphException)
-> (GraphException -> [Char])
-> Exception GraphException
SomeException -> Maybe GraphException
GraphException -> [Char]
GraphException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> [Char]) -> Exception e
$ctoException :: GraphException -> SomeException
toException :: GraphException -> SomeException
$cfromException :: SomeException -> Maybe GraphException
fromException :: SomeException -> Maybe GraphException
$cdisplayException :: GraphException -> [Char]
displayException :: GraphException -> [Char]
Exception)
instance Show GraphException where
show :: GraphException -> [Char]
show GraphException{e
[Char]
[[Char]]
target :: GraphException -> [Char]
stack :: GraphException -> [[Char]]
inner :: ()
target :: [Char]
stack :: [[Char]]
inner :: e
..} = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
[[Char]
"GraphException: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
target] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[[Char]]
stack [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
[[Char]
"Inner exception: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ e -> [Char]
forall a. Show a => a -> [Char]
show e
inner]
fromGraphException :: Typeable b => SomeException -> Maybe b
fromGraphException :: forall b. Typeable b => SomeException -> Maybe b
fromGraphException SomeException
x = do
GraphException [Char]
_ [[Char]]
_ e
e <- SomeException -> Maybe GraphException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
e -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
data Stack = Stack [Key] !KeySet
instance Show Stack where
show :: Stack -> [Char]
show (Stack [Key]
kk KeySet
_) = [Char]
"Stack: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" -> " ((Key -> [Char]) -> [Key] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Key -> [Char]
forall a. Show a => a -> [Char]
show [Key]
kk)
newtype StackException = StackException Stack
deriving (Typeable, Int -> StackException -> [Char] -> [Char]
[StackException] -> [Char] -> [Char]
StackException -> [Char]
(Int -> StackException -> [Char] -> [Char])
-> (StackException -> [Char])
-> ([StackException] -> [Char] -> [Char])
-> Show StackException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> StackException -> [Char] -> [Char]
showsPrec :: Int -> StackException -> [Char] -> [Char]
$cshow :: StackException -> [Char]
show :: StackException -> [Char]
$cshowList :: [StackException] -> [Char] -> [Char]
showList :: [StackException] -> [Char] -> [Char]
Show)
instance Exception StackException where
fromException :: SomeException -> Maybe StackException
fromException = SomeException -> Maybe StackException
forall b. Typeable b => SomeException -> Maybe b
fromGraphException
toException :: StackException -> SomeException
toException this :: StackException
this@(StackException (Stack [Key]
stack KeySet
_)) = GraphException -> SomeException
forall e. Exception e => e -> SomeException
toException (GraphException -> SomeException)
-> GraphException -> SomeException
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> StackException -> GraphException
forall e. Exception e => [Char] -> [[Char]] -> e -> GraphException
GraphException (Key -> [Char]
forall a. Show a => a -> [Char]
show(Key -> [Char]) -> Key -> [Char]
forall a b. (a -> b) -> a -> b
$ [Key] -> Key
forall a. HasCallStack => [a] -> a
last [Key]
stack) ((Key -> [Char]) -> [Key] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Key -> [Char]
forall a. Show a => a -> [Char]
show [Key]
stack) StackException
this
addStack :: Key -> Stack -> Either StackException Stack
addStack :: Key -> Stack -> Either StackException Stack
addStack Key
k (Stack [Key]
ks KeySet
is)
| Key
k Key -> KeySet -> Bool
`memberKeySet` KeySet
is = StackException -> Either StackException Stack
forall a b. a -> Either a b
Left (StackException -> Either StackException Stack)
-> StackException -> Either StackException Stack
forall a b. (a -> b) -> a -> b
$ Stack -> StackException
StackException Stack
stack2
| Bool
otherwise = Stack -> Either StackException Stack
forall a b. b -> Either a b
Right Stack
stack2
where stack2 :: Stack
stack2 = [Key] -> KeySet -> Stack
Stack (Key
kKey -> [Key] -> [Key]
forall a. a -> [a] -> [a]
:[Key]
ks) (Key -> KeySet -> KeySet
insertKeySet Key
k KeySet
is)
memberStack :: Key -> Stack -> Bool
memberStack :: Key -> Stack -> Bool
memberStack Key
k (Stack [Key]
_ KeySet
ks) = Key
k Key -> KeySet -> Bool
`memberKeySet` KeySet
ks
emptyStack :: Stack
emptyStack :: Stack
emptyStack = [Key] -> KeySet -> Stack
Stack [] KeySet
forall a. Monoid a => a
mempty
instance Semigroup a => Semigroup (Rules a) where
Rules a
a <> :: Rules a -> Rules a -> Rules a
<> Rules a
b = (a -> a -> a) -> Rules a -> Rules a -> Rules a
forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Rules a
a Rules a
b
instance Monoid a => Monoid (Rules a) where
mempty :: Rules a
mempty = a -> Rules a
forall a. a -> Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty