{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Development.IDE.Graph.Internal.Types where

import           Control.Applicative
import           Control.Monad.Catch
#if __GLASGOW_HASKELL__ < 808
-- Needed in GHC 8.6.5
import           Control.Concurrent.STM.Stats  (TVar, atomically)
import           Control.Monad.Fail
#else
import           GHC.Conc                      (TVar, atomically)
#endif
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 qualified Data.HashMap.Strict           as Map
import           Data.HashSet                  (HashSet, member)
import qualified Data.HashSet                  as Set
import           Data.IORef
import           Data.List                     (intercalate)
import           Data.Maybe
import           Data.Typeable
import           Development.IDE.Graph.Classes
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)


unwrapDynamic :: forall a . Typeable a => Dynamic -> a
unwrapDynamic :: forall a. Typeable a => Dynamic -> a
unwrapDynamic Dynamic
x = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
msg) forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
x
    where msg :: [Char]
msg = [Char]
"unwrapDynamic failed: Expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. [a] -> [a] -> [a]
++
                [Char]
", but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Dynamic -> TypeRep
dynTypeRep Dynamic
x)

---------------------------------------------------------------------
-- RULES

type TheRules = Map.HashMap TypeRep Dynamic

newtype Rules a = Rules (ReaderT SRules IO a)
    deriving newtype (Applicative 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
return :: forall a. a -> Rules a
$creturn :: forall a. a -> Rules a
>> :: forall a b. Rules a -> Rules b -> Rules b
$c>> :: forall a b. Rules a -> Rules b -> Rules b
>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
$c>>= :: forall a b. Rules a -> (a -> Rules b) -> Rules b
Monad, Functor 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
<* :: forall a b. Rules a -> Rules b -> Rules a
$c<* :: forall a b. Rules a -> Rules b -> Rules a
*> :: forall a b. Rules a -> Rules b -> Rules b
$c*> :: forall a b. Rules a -> Rules b -> Rules b
liftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
$cliftA2 :: forall a b c. (a -> b -> c) -> Rules a -> Rules b -> Rules c
<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
$c<*> :: forall a b. Rules (a -> b) -> Rules a -> Rules b
pure :: forall a. a -> Rules a
$cpure :: forall a. a -> Rules a
Applicative, 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
<$ :: forall a b. a -> Rules b -> Rules a
$c<$ :: forall a b. a -> Rules b -> Rules a
fmap :: forall a b. (a -> b) -> Rules a -> Rules b
$cfmap :: forall a b. (a -> b) -> Rules a -> Rules b
Functor, Monad Rules
forall a. IO a -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Rules a
$cliftIO :: forall a. IO a -> Rules a
MonadIO, Monad Rules
forall a. [Char] -> Rules a
forall (m :: * -> *).
Monad m -> (forall a. [Char] -> m a) -> MonadFail m
fail :: forall a. [Char] -> Rules a
$cfail :: forall a. [Char] -> Rules a
MonadFail)

data SRules = SRules {
    SRules -> Dynamic
rulesExtra   :: !Dynamic,
    SRules -> IORef [Action ()]
rulesActions :: !(IORef [Action ()]),
    SRules -> IORef TheRules
rulesMap     :: !(IORef TheRules)
    }


---------------------------------------------------------------------
-- ACTIONS

newtype Action a = Action {forall a. Action a -> ReaderT SAction IO a
fromAction :: ReaderT SAction IO a}
    deriving newtype (Applicative Action
forall a. a -> Action a
forall a b. Action a -> Action b -> Action b
forall a b. Action a -> (a -> Action b) -> Action b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Action a
$creturn :: forall a. a -> Action a
>> :: forall a b. Action a -> Action b -> Action b
$c>> :: forall a b. Action a -> Action b -> Action b
>>= :: forall a b. Action a -> (a -> Action b) -> Action b
$c>>= :: forall a b. Action a -> (a -> Action b) -> Action b
Monad, Functor Action
forall a. a -> Action a
forall a b. Action a -> Action b -> Action a
forall a b. Action a -> Action b -> Action b
forall a b. Action (a -> b) -> Action a -> Action b
forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Action a -> Action b -> Action a
$c<* :: forall a b. Action a -> Action b -> Action a
*> :: forall a b. Action a -> Action b -> Action b
$c*> :: forall a b. Action a -> Action b -> Action b
liftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
$cliftA2 :: forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
<*> :: forall a b. Action (a -> b) -> Action a -> Action b
$c<*> :: forall a b. Action (a -> b) -> Action a -> Action b
pure :: forall a. a -> Action a
$cpure :: forall a. a -> Action a
Applicative, forall a b. a -> Action b -> Action a
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Action b -> Action a
$c<$ :: forall a b. a -> Action b -> Action a
fmap :: forall a b. (a -> b) -> Action a -> Action b
$cfmap :: forall a b. (a -> b) -> Action a -> Action b
Functor, Monad Action
forall a. IO a -> Action a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Action a
$cliftIO :: forall a. IO a -> Action a
MonadIO, Monad Action
forall a. [Char] -> Action a
forall (m :: * -> *).
Monad m -> (forall a. [Char] -> m a) -> MonadFail m
fail :: forall a. [Char] -> Action a
$cfail :: forall a. [Char] -> Action a
MonadFail, Monad Action
forall e a. Exception e => e -> Action a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Action a
$cthrowM :: forall e a. Exception e => e -> Action a
MonadThrow, MonadThrow Action
forall e a. Exception e => Action a -> (e -> Action a) -> Action a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a. Exception e => Action a -> (e -> Action a) -> Action a
$ccatch :: forall e a. Exception e => Action a -> (e -> Action a) -> Action a
MonadCatch, MonadCatch Action
forall b.
((forall a. Action a -> Action a) -> Action b) -> Action b
forall a b c.
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
$cgeneralBracket :: forall a b c.
Action a
-> (a -> ExitCase b -> Action c)
-> (a -> Action b)
-> Action (b, c)
uninterruptibleMask :: forall b.
((forall a. Action a -> Action a) -> Action b) -> Action b
$cuninterruptibleMask :: forall b.
((forall a. Action a -> Action a) -> Action b) -> Action b
mask :: forall b.
((forall a. Action a -> Action a) -> Action b) -> Action b
$cmask :: forall b.
((forall a. Action a -> Action a) -> Action b) -> Action b
MonadMask, MonadIO 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
withRunInIO :: forall b. ((forall a. Action a -> IO a) -> IO b) -> Action b
$cwithRunInIO :: 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 = forall a. ReaderT SAction IO a -> Action a
Action forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SAction -> Database
actionDatabase

---------------------------------------------------------------------
-- DATABASE

data ShakeDatabase = ShakeDatabase !Int [Action ()] Database

newtype Step = Step Int
    deriving newtype (Step -> Step -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq,Eq Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmax :: Step -> Step -> Step
>= :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c< :: Step -> Step -> Bool
compare :: Step -> Step -> Ordering
$ccompare :: Step -> Step -> Ordering
Ord,Eq Step
Int -> Step -> Int
Step -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Step -> Int
$chash :: Step -> Int
hashWithSalt :: Int -> Step -> Int
$chashWithSalt :: Int -> Step -> Int
Hashable)

data Key = forall a . (Typeable a, Eq a, Hashable a, Show a) => Key a

instance Eq Key where
    Key a
a == :: Key -> Key -> Bool
== Key a
b = forall a. a -> Maybe a
Just a
a forall a. Eq a => a -> a -> Bool
== forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
b

instance Hashable Key where
    hashWithSalt :: Int -> Key -> Int
hashWithSalt Int
i (Key a
x) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (forall a. Typeable a => a -> TypeRep
typeOf a
x, a
x)

instance Show Key where
    show :: Key -> [Char]
show (Key a
x) = forall a. Show a => a -> [Char]
show a
x

newtype Value = Value Dynamic

data KeyDetails = KeyDetails {
    KeyDetails -> Status
keyStatus      :: !Status,
    KeyDetails -> HashSet Key
keyReverseDeps :: !(HashSet Key)
    }

onKeyReverseDeps :: (HashSet Key -> HashSet Key) -> KeyDetails -> KeyDetails
onKeyReverseDeps :: (HashSet Key -> HashSet Key) -> KeyDetails -> KeyDetails
onKeyReverseDeps HashSet Key -> HashSet Key
f it :: KeyDetails
it@KeyDetails{HashSet Key
Status
keyReverseDeps :: HashSet Key
keyStatus :: Status
keyReverseDeps :: KeyDetails -> HashSet Key
keyStatus :: KeyDetails -> Status
..} =
    KeyDetails
it{keyReverseDeps :: HashSet Key
keyReverseDeps = HashSet Key -> HashSet Key
f HashSet Key
keyReverseDeps}

data Database = Database {
    Database -> Dynamic
databaseExtra  :: Dynamic,
    Database -> TheRules
databaseRules  :: TheRules,
    Database -> TVar Step
databaseStep   :: !(TVar Step),
    Database -> Map Key KeyDetails
databaseValues :: !(Map Key KeyDetails)
    }

getDatabaseValues :: Database -> IO [(Key, Status)]
getDatabaseValues :: Database -> IO [(Key, Status)]
getDatabaseValues = forall a. STM a -> IO a
atomically
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second KeyDetails -> Status
keyStatus)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value. Map key value -> ListT STM (key, value)
SMap.listT
                  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,     -- LAZY
        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 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)           = 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 -- watch out: this returns the previous result

data Result = Result {
    Result -> Value
resultValue     :: !Value,
    Result -> Step
resultBuilt     :: !Step, -- ^ the step when it was last recomputed
    Result -> Step
resultChanged   :: !Step, -- ^ the step when it last changed
    Result -> Step
resultVisited   :: !Step, -- ^ the step when it was last looked up
    Result -> ResultDeps
resultDeps      :: !ResultDeps,
    Result -> Seconds
resultExecution :: !Seconds, -- ^ How long it took, last time it ran
    Result -> ByteString
resultData      :: !BS.ByteString
    }

data ResultDeps = UnknownDeps | AlwaysRerunDeps ![Key] | ResultDeps ![Key]
  deriving (ResultDeps -> ResultDeps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultDeps -> ResultDeps -> Bool
$c/= :: ResultDeps -> ResultDeps -> Bool
== :: ResultDeps -> ResultDeps -> Bool
$c== :: ResultDeps -> ResultDeps -> Bool
Eq, Int -> ResultDeps -> ShowS
[ResultDeps] -> ShowS
ResultDeps -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResultDeps] -> ShowS
$cshowList :: [ResultDeps] -> ShowS
show :: ResultDeps -> [Char]
$cshow :: ResultDeps -> [Char]
showsPrec :: Int -> ResultDeps -> ShowS
$cshowsPrec :: Int -> ResultDeps -> ShowS
Show)

getResultDepsDefault :: [Key] -> ResultDeps -> [Key]
getResultDepsDefault :: [Key] -> ResultDeps -> [Key]
getResultDepsDefault [Key]
_ (ResultDeps [Key]
ids)      = [Key]
ids
getResultDepsDefault [Key]
_ (AlwaysRerunDeps [Key]
ids) = [Key]
ids
getResultDepsDefault [Key]
def ResultDeps
UnknownDeps         = [Key]
def

mapResultDeps :: ([Key] -> [Key]) -> ResultDeps -> ResultDeps
mapResultDeps :: ([Key] -> [Key]) -> ResultDeps -> ResultDeps
mapResultDeps [Key] -> [Key]
f (ResultDeps [Key]
ids)      = [Key] -> ResultDeps
ResultDeps forall a b. (a -> b) -> a -> b
$ [Key] -> [Key]
f [Key]
ids
mapResultDeps [Key] -> [Key]
f (AlwaysRerunDeps [Key]
ids) = [Key] -> ResultDeps
AlwaysRerunDeps forall a b. (a -> b) -> a -> b
$ [Key] -> [Key]
f [Key]
ids
mapResultDeps [Key] -> [Key]
_ ResultDeps
UnknownDeps           = ResultDeps
UnknownDeps

instance Semigroup ResultDeps where
    ResultDeps
UnknownDeps <> :: ResultDeps -> ResultDeps -> ResultDeps
<> ResultDeps
x = ResultDeps
x
    ResultDeps
x <> ResultDeps
UnknownDeps = ResultDeps
x
    AlwaysRerunDeps [Key]
ids <> ResultDeps
x = [Key] -> ResultDeps
AlwaysRerunDeps ([Key]
ids forall a. Semigroup a => a -> a -> a
<> [Key] -> ResultDeps -> [Key]
getResultDepsDefault [] ResultDeps
x)
    ResultDeps
x <> AlwaysRerunDeps [Key]
ids = [Key] -> ResultDeps
AlwaysRerunDeps ([Key] -> ResultDeps -> [Key]
getResultDepsDefault [] ResultDeps
x forall a. Semigroup a => a -> a -> a
<> [Key]
ids)
    ResultDeps [Key]
ids <> ResultDeps [Key]
ids' = [Key] -> ResultDeps
ResultDeps ([Key]
ids forall a. Semigroup a => a -> a -> a
<> [Key]
ids')

instance Monoid ResultDeps where
    mempty :: ResultDeps
mempty = ResultDeps
UnknownDeps

---------------------------------------------------------------------
-- Running builds

-- | 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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RunMode] -> ShowS
$cshowList :: [RunMode] -> ShowS
show :: RunMode -> [Char]
$cshow :: RunMode -> [Char]
showsPrec :: Int -> RunMode -> ShowS
$cshowsPrec :: Int -> RunMode -> ShowS
Show)

instance NFData RunMode where rnf :: RunMode -> ()
rnf RunMode
x = RunMode
x seq :: forall a b. a -> b -> b
`seq` ()

-- | 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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RunChanged] -> ShowS
$cshowList :: [RunChanged] -> ShowS
show :: RunChanged -> [Char]
$cshow :: RunChanged -> [Char]
showsPrec :: Int -> RunChanged -> ShowS
$cshowsPrec :: Int -> RunChanged -> ShowS
Show,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
$cto :: forall x. Rep RunChanged x -> RunChanged
$cfrom :: forall x. RunChanged -> Rep RunChanged x
Generic)
      deriving anyclass (Value -> Parser [RunChanged]
Value -> Parser RunChanged
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RunChanged]
$cparseJSONList :: Value -> Parser [RunChanged]
parseJSON :: Value -> Parser RunChanged
$cparseJSON :: Value -> Parser RunChanged
FromJSON, [RunChanged] -> Encoding
[RunChanged] -> Value
RunChanged -> Encoding
RunChanged -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RunChanged] -> Encoding
$ctoEncodingList :: [RunChanged] -> Encoding
toJSONList :: [RunChanged] -> Value
$ctoJSONList :: [RunChanged] -> Value
toEncoding :: RunChanged -> Encoding
$ctoEncoding :: RunChanged -> Encoding
toJSON :: RunChanged -> Value
$ctoJSON :: RunChanged -> Value
ToJSON)

instance NFData RunChanged where rnf :: RunChanged -> ()
rnf RunChanged
x = RunChanged
x seq :: forall a b. a -> b -> b
`seq` ()

-- | The result of 'BuiltinRun'.
data RunResult value = RunResult
    {forall value. RunResult value -> RunChanged
runChanged :: RunChanged
        -- ^ How has the 'RunResult' changed from what happened last time.
    ,forall value. RunResult value -> ByteString
runStore   :: BS.ByteString
        -- ^ The value to store in the Shake database.
    ,forall value. RunResult value -> value
runValue   :: value
        -- ^ The value to return from 'Development.Shake.Rule.apply'.
    } deriving forall a b. a -> RunResult b -> RunResult a
forall a b. (a -> b) -> RunResult a -> RunResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RunResult b -> RunResult a
$c<$ :: forall a b. a -> RunResult b -> RunResult a
fmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
$cfmap :: forall a b. (a -> b) -> RunResult a -> RunResult b
Functor

instance NFData value => NFData (RunResult value) where
    rnf :: RunResult value -> ()
rnf (RunResult RunChanged
x1 ByteString
x2 value
x3) = forall a. NFData a => a -> ()
rnf RunChanged
x1 seq :: forall a b. a -> b -> b
`seq` ByteString
x2 seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf value
x3

---------------------------------------------------------------------
-- EXCEPTIONS

data GraphException = forall e. Exception e => GraphException {
    GraphException -> [Char]
target :: String, -- ^ The key that was being built
    GraphException -> [[Char]]
stack  :: [String], -- ^ The stack of keys that led to this exception
    ()
inner  :: e -- ^ The underlying exception
}
  deriving (Typeable, Show GraphException
Typeable GraphException
SomeException -> Maybe GraphException
GraphException -> [Char]
GraphException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> Exception e
displayException :: GraphException -> [Char]
$cdisplayException :: GraphException -> [Char]
fromException :: SomeException -> Maybe GraphException
$cfromException :: SomeException -> Maybe GraphException
toException :: GraphException -> SomeException
$ctoException :: GraphException -> SomeException
Exception)

instance Show GraphException where
    show :: GraphException -> [Char]
show GraphException{e
[Char]
[[Char]]
inner :: e
stack :: [[Char]]
target :: [Char]
inner :: ()
stack :: GraphException -> [[Char]]
target :: GraphException -> [Char]
..} = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$
        [[Char]
"GraphException: " forall a. [a] -> [a] -> [a]
++ [Char]
target] forall a. [a] -> [a] -> [a]
++
        [[Char]]
stack forall a. [a] -> [a] -> [a]
++
        [[Char]
"Inner exception: " forall a. [a] -> [a] -> [a]
++ 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 <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

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

data Stack = Stack [Key] !(HashSet Key)

instance Show Stack where
    show :: Stack -> [Char]
show (Stack [Key]
kk HashSet Key
_) = [Char]
"Stack: " forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" -> " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Key]
kk)

newtype StackException = StackException Stack
  deriving (Typeable, Int -> StackException -> ShowS
[StackException] -> ShowS
StackException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StackException] -> ShowS
$cshowList :: [StackException] -> ShowS
show :: StackException -> [Char]
$cshow :: StackException -> [Char]
showsPrec :: Int -> StackException -> ShowS
$cshowsPrec :: Int -> StackException -> ShowS
Show)

instance Exception StackException where
    fromException :: SomeException -> Maybe StackException
fromException = forall b. Typeable b => SomeException -> Maybe b
fromGraphException
    toException :: StackException -> SomeException
toException this :: StackException
this@(StackException (Stack [Key]
stack HashSet Key
_)) = forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$
        forall e. Exception e => [Char] -> [[Char]] -> e -> GraphException
GraphException (forall a. Show a => a -> [Char]
showforall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Key]
stack) (forall a b. (a -> b) -> [a] -> [b]
map 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 HashSet Key
is)
    | Key
k forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`member` HashSet Key
is = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Stack -> StackException
StackException Stack
stack2
    | Bool
otherwise = forall a b. b -> Either a b
Right Stack
stack2
    where stack2 :: Stack
stack2 = [Key] -> HashSet Key -> Stack
Stack (Key
kforall a. a -> [a] -> [a]
:[Key]
ks) (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert Key
k HashSet Key
is)

memberStack :: Key -> Stack -> Bool
memberStack :: Key -> Stack -> Bool
memberStack Key
k (Stack [Key]
_ HashSet Key
ks) = Key
k forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`member` HashSet Key
ks

emptyStack :: Stack
emptyStack :: Stack
emptyStack = [Key] -> HashSet Key -> Stack
Stack [] forall a. Monoid a => a
mempty
---------------------------------------------------------------------
-- INSTANCES

instance Semigroup a => Semigroup (Rules a) where
    Rules a
a <> :: Rules a -> Rules a -> Rules a
<> Rules a
b = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) Rules a
a Rules a
b

instance Monoid a => Monoid (Rules a) where
    mempty :: Rules a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty