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

module Development.IDE.Graph.Internal.Types where

import           Control.Applicative
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.Coerce
import           Data.Dynamic
import qualified Data.HashMap.Strict           as Map
import qualified Data.IntMap.Strict            as IM
import           Data.IntMap                   (IntMap)
import qualified Data.IntSet                   as IS
import           Data.IntSet                   (IntSet)
import qualified Data.Text                     as T
import           Data.Text                     (Text)
import           Data.IORef
import           Data.List                     (intercalate)
import           Data.Maybe
import           Data.Typeable
import           Development.IDE.Graph.Classes
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           System.IO.Unsafe
import           UnliftIO                      (MonadUnliftIO)


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)

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

type TheRules = Map.HashMap TypeRep Dynamic

-- | A computation that defines all the rules that form part of the computation graph.
--
-- 'Rules' has access to 'IO' through 'MonadIO'. Use of 'IO' is at your own risk: if
-- you write 'Rules' that throw exceptions, then you need to make sure to handle them
-- yourself when you run the resulting 'Rules'.
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 {
    SRules -> Dynamic
rulesExtra   :: !Dynamic,
    SRules -> IORef [Action ()]
rulesActions :: !(IORef [Action ()]),
    SRules -> IORef TheRules
rulesMap     :: !(IORef TheRules)
    }


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

-- | An action representing something that can be run as part of a 'Rule'.
-- 
-- 'Action's can be pure functions but also have access to 'IO' via 'MonadIO' and 'MonadUnliftIO.
-- It should be assumed that actions throw exceptions, these can be caught with
-- 'Development.IDE.Graph.Internal.Action.actionCatch'. In particular, it is 
-- permissible to use the 'MonadFail' instance, which will lead to an 'IOException'.
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

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

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)

---------------------------------------------------------------------
-- Keys

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

newtype Key = UnsafeMkKey Int

pattern $mKey :: forall {r}.
Key
-> (forall {a}. (Typeable a, Hashable a, Show a) => a -> r)
-> ((# #) -> r)
-> r
Key a <- (lookupKeyValue -> KeyValue a _)

data GlobalKeyValueMap = GlobalKeyValueMap !(Map.HashMap KeyValue Key) !(IntMap KeyValue) {-# UNPACK #-} !Int

keyMap :: IORef GlobalKeyValueMap
keyMap :: IORef GlobalKeyValueMap
keyMap = IO (IORef GlobalKeyValueMap) -> IORef GlobalKeyValueMap
forall a. IO a -> a
unsafePerformIO (IO (IORef GlobalKeyValueMap) -> IORef GlobalKeyValueMap)
-> IO (IORef GlobalKeyValueMap) -> IORef GlobalKeyValueMap
forall a b. (a -> b) -> a -> b
$ GlobalKeyValueMap -> IO (IORef GlobalKeyValueMap)
forall a. a -> IO (IORef a)
newIORef (HashMap KeyValue Key -> IntMap KeyValue -> Int -> GlobalKeyValueMap
GlobalKeyValueMap HashMap KeyValue Key
forall k v. HashMap k v
Map.empty IntMap KeyValue
forall a. IntMap a
IM.empty Int
0)

{-# NOINLINE keyMap #-}

newKey :: (Eq a, Typeable a, Hashable a, Show a) => a -> Key
newKey :: forall a. (Eq a, Typeable a, Hashable a, Show a) => a -> Key
newKey a
k = IO Key -> Key
forall a. IO a -> a
unsafePerformIO (IO Key -> Key) -> IO Key -> Key
forall a b. (a -> b) -> a -> b
$ do
  let !newKey :: KeyValue
newKey = a -> Text -> KeyValue
forall a.
(Eq a, Typeable a, Hashable a, Show a) =>
a -> Text -> KeyValue
KeyValue a
k ([Char] -> Text
T.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
k))
  IORef GlobalKeyValueMap
-> (GlobalKeyValueMap -> (GlobalKeyValueMap, Key)) -> IO Key
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef GlobalKeyValueMap
keyMap ((GlobalKeyValueMap -> (GlobalKeyValueMap, Key)) -> IO Key)
-> (GlobalKeyValueMap -> (GlobalKeyValueMap, Key)) -> IO Key
forall a b. (a -> b) -> a -> b
$ \km :: GlobalKeyValueMap
km@(GlobalKeyValueMap HashMap KeyValue Key
hm IntMap KeyValue
im Int
n) ->
    let new_key :: Maybe Key
new_key = KeyValue -> HashMap KeyValue Key -> Maybe Key
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup KeyValue
newKey HashMap KeyValue Key
hm
    in case Maybe Key
new_key of
          Just Key
v  -> (GlobalKeyValueMap
km, Key
v)
          Maybe Key
Nothing ->
            let !new_index :: Key
new_index = Int -> Key
UnsafeMkKey Int
n
            in (HashMap KeyValue Key -> IntMap KeyValue -> Int -> GlobalKeyValueMap
GlobalKeyValueMap (KeyValue -> Key -> HashMap KeyValue Key -> HashMap KeyValue Key
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert KeyValue
newKey Key
new_index HashMap KeyValue Key
hm) (Int -> KeyValue -> IntMap KeyValue -> IntMap KeyValue
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
n KeyValue
newKey IntMap KeyValue
im) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Key
new_index)
{-# NOINLINE newKey #-}

lookupKeyValue :: Key -> KeyValue
lookupKeyValue :: Key -> KeyValue
lookupKeyValue (UnsafeMkKey Int
x) = IO KeyValue -> KeyValue
forall a. IO a -> a
unsafePerformIO (IO KeyValue -> KeyValue) -> IO KeyValue -> KeyValue
forall a b. (a -> b) -> a -> b
$ do
  GlobalKeyValueMap HashMap KeyValue Key
_ IntMap KeyValue
im Int
_ <- IORef GlobalKeyValueMap -> IO GlobalKeyValueMap
forall a. IORef a -> IO a
readIORef IORef GlobalKeyValueMap
keyMap
  KeyValue -> IO KeyValue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyValue -> IO KeyValue) -> KeyValue -> IO KeyValue
forall a b. (a -> b) -> a -> b
$! IntMap KeyValue
im IntMap KeyValue -> Int -> KeyValue
forall a. IntMap a -> Int -> a
IM.! Int
x

{-# NOINLINE lookupKeyValue #-}

instance Eq Key where
  UnsafeMkKey Int
a == :: Key -> Key -> Bool
== UnsafeMkKey Int
b = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
instance Hashable Key where
  hashWithSalt :: Int -> Key -> Int
hashWithSalt Int
i (UnsafeMkKey Int
x) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i Int
x
instance Show Key where
  show :: Key -> [Char]
show (Key a
x) = a -> [Char]
forall a. Show a => a -> [Char]
show a
x

instance Eq KeyValue where
    KeyValue a
a Text
_ == :: KeyValue -> KeyValue -> Bool
== KeyValue a
b Text
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
b
instance Hashable KeyValue where
    hashWithSalt :: Int -> KeyValue -> Int
hashWithSalt Int
i (KeyValue a
x Text
_) = Int -> (TypeRep, a) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x, a
x)
instance Show KeyValue where
    show :: KeyValue -> [Char]
show (KeyValue a
x Text
t) = Text -> [Char]
T.unpack Text
t

renderKey :: Key -> Text
renderKey :: Key -> Text
renderKey (Key -> KeyValue
lookupKeyValue -> KeyValue a
_ Text
t) = Text
t

newtype KeySet = KeySet IntSet
  deriving newtype (KeySet -> KeySet -> Bool
(KeySet -> KeySet -> Bool)
-> (KeySet -> KeySet -> Bool) -> Eq KeySet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeySet -> KeySet -> Bool
== :: KeySet -> KeySet -> Bool
$c/= :: KeySet -> KeySet -> Bool
/= :: KeySet -> KeySet -> Bool
Eq, Eq KeySet
Eq KeySet =>
(KeySet -> KeySet -> Ordering)
-> (KeySet -> KeySet -> Bool)
-> (KeySet -> KeySet -> Bool)
-> (KeySet -> KeySet -> Bool)
-> (KeySet -> KeySet -> Bool)
-> (KeySet -> KeySet -> KeySet)
-> (KeySet -> KeySet -> KeySet)
-> Ord KeySet
KeySet -> KeySet -> Bool
KeySet -> KeySet -> Ordering
KeySet -> KeySet -> KeySet
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 :: KeySet -> KeySet -> Ordering
compare :: KeySet -> KeySet -> Ordering
$c< :: KeySet -> KeySet -> Bool
< :: KeySet -> KeySet -> Bool
$c<= :: KeySet -> KeySet -> Bool
<= :: KeySet -> KeySet -> Bool
$c> :: KeySet -> KeySet -> Bool
> :: KeySet -> KeySet -> Bool
$c>= :: KeySet -> KeySet -> Bool
>= :: KeySet -> KeySet -> Bool
$cmax :: KeySet -> KeySet -> KeySet
max :: KeySet -> KeySet -> KeySet
$cmin :: KeySet -> KeySet -> KeySet
min :: KeySet -> KeySet -> KeySet
Ord, NonEmpty KeySet -> KeySet
KeySet -> KeySet -> KeySet
(KeySet -> KeySet -> KeySet)
-> (NonEmpty KeySet -> KeySet)
-> (forall b. Integral b => b -> KeySet -> KeySet)
-> Semigroup KeySet
forall b. Integral b => b -> KeySet -> KeySet
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: KeySet -> KeySet -> KeySet
<> :: KeySet -> KeySet -> KeySet
$csconcat :: NonEmpty KeySet -> KeySet
sconcat :: NonEmpty KeySet -> KeySet
$cstimes :: forall b. Integral b => b -> KeySet -> KeySet
stimes :: forall b. Integral b => b -> KeySet -> KeySet
Semigroup, Semigroup KeySet
KeySet
Semigroup KeySet =>
KeySet
-> (KeySet -> KeySet -> KeySet)
-> ([KeySet] -> KeySet)
-> Monoid KeySet
[KeySet] -> KeySet
KeySet -> KeySet -> KeySet
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: KeySet
mempty :: KeySet
$cmappend :: KeySet -> KeySet -> KeySet
mappend :: KeySet -> KeySet -> KeySet
$cmconcat :: [KeySet] -> KeySet
mconcat :: [KeySet] -> KeySet
Monoid)

instance Show KeySet where
  showsPrec :: Int -> KeySet -> [Char] -> [Char]
showsPrec Int
p (KeySet IntSet
is)= Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [Char] -> [Char] -> [Char]
showString [Char]
"fromList " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows [Key]
ks
    where ks :: [Key]
ks = [Int] -> [Key]
forall a b. Coercible a b => a -> b
coerce (IntSet -> [Int]
IS.toList IntSet
is) :: [Key]

insertKeySet :: Key -> KeySet -> KeySet
insertKeySet :: Key -> KeySet -> KeySet
insertKeySet = (Int -> IntSet -> IntSet) -> Key -> KeySet -> KeySet
forall a b. Coercible a b => a -> b
coerce Int -> IntSet -> IntSet
IS.insert

memberKeySet :: Key -> KeySet -> Bool
memberKeySet :: Key -> KeySet -> Bool
memberKeySet = (Int -> IntSet -> Bool) -> Key -> KeySet -> Bool
forall a b. Coercible a b => a -> b
coerce Int -> IntSet -> Bool
IS.member

toListKeySet :: KeySet -> [Key]
toListKeySet :: KeySet -> [Key]
toListKeySet = (IntSet -> [Int]) -> KeySet -> [Key]
forall a b. Coercible a b => a -> b
coerce IntSet -> [Int]
IS.toList

nullKeySet :: KeySet -> Bool
nullKeySet :: KeySet -> Bool
nullKeySet = (IntSet -> Bool) -> KeySet -> Bool
forall a b. Coercible a b => a -> b
coerce IntSet -> Bool
IS.null

differenceKeySet :: KeySet -> KeySet -> KeySet
differenceKeySet :: KeySet -> KeySet -> KeySet
differenceKeySet = (IntSet -> IntSet -> IntSet) -> KeySet -> KeySet -> KeySet
forall a b. Coercible a b => a -> b
coerce IntSet -> IntSet -> IntSet
IS.difference

deleteKeySet :: Key -> KeySet -> KeySet
deleteKeySet :: Key -> KeySet -> KeySet
deleteKeySet = (Int -> IntSet -> IntSet) -> Key -> KeySet -> KeySet
forall a b. Coercible a b => a -> b
coerce Int -> IntSet -> IntSet
IS.delete

fromListKeySet :: [Key] -> KeySet
fromListKeySet :: [Key] -> KeySet
fromListKeySet = ([Int] -> IntSet) -> [Key] -> KeySet
forall a b. Coercible a b => a -> b
coerce [Int] -> IntSet
IS.fromList

singletonKeySet :: Key -> KeySet
singletonKeySet :: Key -> KeySet
singletonKeySet = (Int -> IntSet) -> Key -> KeySet
forall a b. Coercible a b => a -> b
coerce Int -> IntSet
IS.singleton

filterKeySet :: (Key -> Bool) -> KeySet -> KeySet
filterKeySet :: (Key -> Bool) -> KeySet -> KeySet
filterKeySet = ((Int -> Bool) -> IntSet -> IntSet)
-> (Key -> Bool) -> KeySet -> KeySet
forall a b. Coercible a b => a -> b
coerce (Int -> Bool) -> IntSet -> IntSet
IS.filter

lengthKeySet :: KeySet -> Int
lengthKeySet :: KeySet -> Int
lengthKeySet = (IntSet -> Int) -> KeySet -> Int
forall a b. Coercible a b => a -> b
coerce IntSet -> Int
IS.size

newtype KeyMap a = KeyMap (IntMap a)
  deriving newtype (KeyMap a -> KeyMap a -> Bool
(KeyMap a -> KeyMap a -> Bool)
-> (KeyMap a -> KeyMap a -> Bool) -> Eq (KeyMap a)
forall a. Eq a => KeyMap a -> KeyMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => KeyMap a -> KeyMap a -> Bool
== :: KeyMap a -> KeyMap a -> Bool
$c/= :: forall a. Eq a => KeyMap a -> KeyMap a -> Bool
/= :: KeyMap a -> KeyMap a -> Bool
Eq, Eq (KeyMap a)
Eq (KeyMap a) =>
(KeyMap a -> KeyMap a -> Ordering)
-> (KeyMap a -> KeyMap a -> Bool)
-> (KeyMap a -> KeyMap a -> Bool)
-> (KeyMap a -> KeyMap a -> Bool)
-> (KeyMap a -> KeyMap a -> Bool)
-> (KeyMap a -> KeyMap a -> KeyMap a)
-> (KeyMap a -> KeyMap a -> KeyMap a)
-> Ord (KeyMap a)
KeyMap a -> KeyMap a -> Bool
KeyMap a -> KeyMap a -> Ordering
KeyMap a -> KeyMap a -> KeyMap a
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
forall a. Ord a => Eq (KeyMap a)
forall a. Ord a => KeyMap a -> KeyMap a -> Bool
forall a. Ord a => KeyMap a -> KeyMap a -> Ordering
forall a. Ord a => KeyMap a -> KeyMap a -> KeyMap a
$ccompare :: forall a. Ord a => KeyMap a -> KeyMap a -> Ordering
compare :: KeyMap a -> KeyMap a -> Ordering
$c< :: forall a. Ord a => KeyMap a -> KeyMap a -> Bool
< :: KeyMap a -> KeyMap a -> Bool
$c<= :: forall a. Ord a => KeyMap a -> KeyMap a -> Bool
<= :: KeyMap a -> KeyMap a -> Bool
$c> :: forall a. Ord a => KeyMap a -> KeyMap a -> Bool
> :: KeyMap a -> KeyMap a -> Bool
$c>= :: forall a. Ord a => KeyMap a -> KeyMap a -> Bool
>= :: KeyMap a -> KeyMap a -> Bool
$cmax :: forall a. Ord a => KeyMap a -> KeyMap a -> KeyMap a
max :: KeyMap a -> KeyMap a -> KeyMap a
$cmin :: forall a. Ord a => KeyMap a -> KeyMap a -> KeyMap a
min :: KeyMap a -> KeyMap a -> KeyMap a
Ord, NonEmpty (KeyMap a) -> KeyMap a
KeyMap a -> KeyMap a -> KeyMap a
(KeyMap a -> KeyMap a -> KeyMap a)
-> (NonEmpty (KeyMap a) -> KeyMap a)
-> (forall b. Integral b => b -> KeyMap a -> KeyMap a)
-> Semigroup (KeyMap a)
forall b. Integral b => b -> KeyMap a -> KeyMap a
forall a. NonEmpty (KeyMap a) -> KeyMap a
forall a. KeyMap a -> KeyMap a -> KeyMap a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> KeyMap a -> KeyMap a
$c<> :: forall a. KeyMap a -> KeyMap a -> KeyMap a
<> :: KeyMap a -> KeyMap a -> KeyMap a
$csconcat :: forall a. NonEmpty (KeyMap a) -> KeyMap a
sconcat :: NonEmpty (KeyMap a) -> KeyMap a
$cstimes :: forall a b. Integral b => b -> KeyMap a -> KeyMap a
stimes :: forall b. Integral b => b -> KeyMap a -> KeyMap a
Semigroup, Semigroup (KeyMap a)
KeyMap a
Semigroup (KeyMap a) =>
KeyMap a
-> (KeyMap a -> KeyMap a -> KeyMap a)
-> ([KeyMap a] -> KeyMap a)
-> Monoid (KeyMap a)
[KeyMap a] -> KeyMap a
KeyMap a -> KeyMap a -> KeyMap a
forall a. Semigroup (KeyMap a)
forall a. KeyMap a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [KeyMap a] -> KeyMap a
forall a. KeyMap a -> KeyMap a -> KeyMap a
$cmempty :: forall a. KeyMap a
mempty :: KeyMap a
$cmappend :: forall a. KeyMap a -> KeyMap a -> KeyMap a
mappend :: KeyMap a -> KeyMap a -> KeyMap a
$cmconcat :: forall a. [KeyMap a] -> KeyMap a
mconcat :: [KeyMap a] -> KeyMap a
Monoid)

instance Show a => Show (KeyMap a) where
  showsPrec :: Int -> KeyMap a -> [Char] -> [Char]
showsPrec Int
p (KeyMap IntMap a
im)= Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [Char] -> [Char] -> [Char]
showString [Char]
"fromList " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, a)] -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows [(Key, a)]
ks
    where ks :: [(Key, a)]
ks = [(Int, a)] -> [(Key, a)]
forall a b. Coercible a b => a -> b
coerce (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap a
im) :: [(Key,a)]

mapKeyMap :: (a -> b) -> KeyMap a -> KeyMap b
mapKeyMap :: forall a b. (a -> b) -> KeyMap a -> KeyMap b
mapKeyMap a -> b
f (KeyMap IntMap a
m) = IntMap b -> KeyMap b
forall a. IntMap a -> KeyMap a
KeyMap ((a -> b) -> IntMap a -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map a -> b
f IntMap a
m)

insertKeyMap :: Key -> a -> KeyMap a -> KeyMap a
insertKeyMap :: forall a. Key -> a -> KeyMap a -> KeyMap a
insertKeyMap (UnsafeMkKey Int
k) a
v (KeyMap IntMap a
m) = IntMap a -> KeyMap a
forall a. IntMap a -> KeyMap a
KeyMap (Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
k a
v IntMap a
m)

lookupKeyMap :: Key -> KeyMap a -> Maybe a
lookupKeyMap :: forall a. Key -> KeyMap a -> Maybe a
lookupKeyMap (UnsafeMkKey Int
k) (KeyMap IntMap a
m) = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k IntMap a
m

lookupDefaultKeyMap :: a -> Key -> KeyMap a -> a
lookupDefaultKeyMap :: forall a. a -> Key -> KeyMap a -> a
lookupDefaultKeyMap a
a (UnsafeMkKey Int
k) (KeyMap IntMap a
m) = a -> Int -> IntMap a -> a
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault a
a Int
k IntMap a
m

fromListKeyMap :: [(Key,a)] -> KeyMap a
fromListKeyMap :: forall a. [(Key, a)] -> KeyMap a
fromListKeyMap [(Key, a)]
xs = IntMap a -> KeyMap a
forall a. IntMap a -> KeyMap a
KeyMap ([(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Key, a)] -> [(Int, a)]
forall a b. Coercible a b => a -> b
coerce [(Key, a)]
xs))

fromListWithKeyMap :: (a -> a -> a) -> [(Key,a)] -> KeyMap a
fromListWithKeyMap :: forall a. (a -> a -> a) -> [(Key, a)] -> KeyMap a
fromListWithKeyMap a -> a -> a
f [(Key, a)]
xs = IntMap a -> KeyMap a
forall a. IntMap a -> KeyMap a
KeyMap ((a -> a -> a) -> [(Int, a)] -> IntMap a
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith a -> a -> a
f ([(Key, a)] -> [(Int, a)]
forall a b. Coercible a b => a -> b
coerce [(Key, a)]
xs))

toListKeyMap :: KeyMap a -> [(Key,a)]
toListKeyMap :: forall a. KeyMap a -> [(Key, a)]
toListKeyMap (KeyMap IntMap a
m) = [(Int, a)] -> [(Key, a)]
forall a b. Coercible a b => a -> b
coerce (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap a
m)

elemsKeyMap :: KeyMap a -> [a]
elemsKeyMap :: forall a. KeyMap a -> [a]
elemsKeyMap (KeyMap IntMap a
m) = IntMap a -> [a]
forall a. IntMap a -> [a]
IM.elems IntMap a
m

restrictKeysKeyMap :: KeyMap a -> KeySet -> KeyMap a
restrictKeysKeyMap :: forall a. KeyMap a -> KeySet -> KeyMap a
restrictKeysKeyMap (KeyMap IntMap a
m) (KeySet IntSet
s) = IntMap a -> KeyMap a
forall a. IntMap a -> KeyMap a
KeyMap (IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
IM.restrictKeys IntMap a
m IntSet
s)


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{Status
KeySet
keyStatus :: KeyDetails -> Status
keyReverseDeps :: KeyDetails -> KeySet
keyStatus :: Status
keyReverseDeps :: KeySet
..} =
    KeyDetails
it{keyReverseDeps = f 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 = 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,     -- 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 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 -- 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 !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
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
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

---------------------------------------------------------------------
-- 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
(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` ()

-- | 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
$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` ()

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

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 () -> () -> ()
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

---------------------------------------------------------------------
-- 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
(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

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

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
---------------------------------------------------------------------
-- INSTANCES

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