{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Defines the basic 'Rule' datatype and its core operations.
module Hasura.Incremental.Internal.Rule
  ( ArrowDistribute (..),
    Result (rebuildRule, result),
    Rule (..),
    build,
    rebuild,
  )
where

import Control.Arrow.Extended
import Control.Category
import Data.HashMap.Strict qualified as HM
import Data.Profunctor
import Data.Tuple (swap)
import Hasura.Incremental.Internal.Dependency
import Hasura.Prelude hiding (id, (.))

-- | A value of type @'Rule' m a b@ is a /build rule/: a computation that describes how to build a
-- value of type @b@ from a value of type @a@ in a monad @m@. What distinguishes @'Rule' m a b@ from
-- an ordinary function of type @a -> m b@ is that it can be made /incremental/ (in the sense of
-- “incremental compilation”)—after executing it, future executions can perform a subset of the
-- required work if only a portion of the input changed.
--
-- To achieve this, 'Rule's have a more restrictive interface: there is no @Monad ('Rule' m a)@
-- instance, for example. Instead, 'Rule's are composed using the 'Arrow' hierarchy of operations,
-- which ensures that the dependency graph of build rules is mostly static (though it may contain
-- conditional branches, and combinators such as 'keyed' can express restricted forms of dynamic
-- dependencies). Each atomic rule may be defined using the 'Monad' instance for @m@, but
-- incrementalization is not supported inside those rules — they are treated as a single, monolithic
-- computation.
--
-- Atomic rules are created with the 'arrM' function, and caching can be added to a rule using the
-- 'cache' combinator. Rules can be executed using the 'build' function, which returns a 'Result'. A
-- 'Result' contains the built value, accessible via 'result', but it also allows supplying a new
-- input value using 'rebuild' to produce a new result incrementally.
newtype Rule m a b
  = -- Note: this is a CPS encoding of `Accesses -> a -> m (Result m a b)`. In practice, the CPS
    -- encoding seems to provide meaningful performance improvements: it cuts down significantly on
    -- allocation and is friendlier to GHC’s optimizer.
    Rule (forall r. Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)

build :: (Applicative m) => Rule m a b -> a -> m (Result m a b)
build :: Rule m a b -> a -> m (Result m a b)
build (Rule forall r.
Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r
r) a
a = Accesses
-> a
-> (Accesses -> b -> Rule m a b -> m (Result m a b))
-> m (Result m a b)
forall r.
Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r
r Accesses
forall a. Monoid a => a
mempty a
a \Accesses
_ b
b Rule m a b
r' -> Result m a b -> m (Result m a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result m a b -> m (Result m a b))
-> Result m a b -> m (Result m a b)
forall a b. (a -> b) -> a -> b
$ b -> Rule m a b -> Result m a b
forall (m :: * -> *) a b. b -> Rule m a b -> Result m a b
Result b
b Rule m a b
r'
{-# INLINE build #-}

data Result m a b = Result
  { Result m a b -> b
result :: !b,
    Result m a b -> Rule m a b
rebuildRule :: !(Rule m a b)
  }
  deriving (a -> Result m a b -> Result m a a
(a -> b) -> Result m a a -> Result m a b
(forall a b. (a -> b) -> Result m a a -> Result m a b)
-> (forall a b. a -> Result m a b -> Result m a a)
-> Functor (Result m a)
forall a b. a -> Result m a b -> Result m a a
forall a b. (a -> b) -> Result m a a -> Result m a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a a b. a -> Result m a b -> Result m a a
forall (m :: * -> *) a a b.
(a -> b) -> Result m a a -> Result m a b
<$ :: a -> Result m a b -> Result m a a
$c<$ :: forall (m :: * -> *) a a b. a -> Result m a b -> Result m a a
fmap :: (a -> b) -> Result m a a -> Result m a b
$cfmap :: forall (m :: * -> *) a a b.
(a -> b) -> Result m a a -> Result m a b
Functor)

rebuild :: (Applicative m) => Result m a b -> a -> m (Result m a b)
rebuild :: Result m a b -> a -> m (Result m a b)
rebuild = Rule m a b -> a -> m (Result m a b)
forall (m :: * -> *) a b.
Applicative m =>
Rule m a b -> a -> m (Result m a b)
build (Rule m a b -> a -> m (Result m a b))
-> (Result m a b -> Rule m a b)
-> Result m a b
-> a
-> m (Result m a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Result m a b -> Rule m a b
forall (m :: * -> *) a b. Result m a b -> Rule m a b
rebuildRule
{-# INLINE rebuild #-}

{- Note [Rule rewrite rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As explained by Note [Arrow rewrite rules] in Control.Arrow.Extended, it’s important to define
type-specific rewrite rules to get good performance with arrows when the concrete type is used. This
is especially important for `Rule`, since the recursive definitions of operations like `.` and `arr`
are very difficult for the optimizer to deal with, and the composition of lots of small rules
created with `arr` is very inefficient.

Since GHC aggressively specializes and inlines class methods, the rules cannot be defined on the
class methods themselves. Instead, the class methods expand to auxiliary definitions, and those
definitions include an INLINABLE[0] pragma that ensures they do not inline until the final
optimization phase. The rules are defined in terms of those definitions, so they will be able to do
their work in prior phases.

Note [Desugaring derived operations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
One subtlety to the above is that we want to define operations in terms of other operations as much
as possible to avoid the need to write an enormous number of rewrite rules, but if we define them
that way directly, then we’ll end up using needlessly inefficient implementations when the
operations aren’t specialized. Therefore, we provide efficient implementations of operations like
`second`, but aggressively rewrite them in terms of simpler primitives like `first` when GHC is able
to specialize them. -}

rComp :: Rule m a1 b -> Rule m a2 a1 -> Rule m a2 b
Rule forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
f rComp :: Rule m a1 b -> Rule m a2 a1 -> Rule m a2 b
`rComp` Rule forall r.
Accesses -> a2 -> (Accesses -> a1 -> Rule m a2 a1 -> m r) -> m r
g = (forall r.
 Accesses -> a2 -> (Accesses -> b -> Rule m a2 b -> m r) -> m r)
-> Rule m a2 b
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a2
a Accesses -> b -> Rule m a2 b -> m r
k -> Accesses -> a2 -> (Accesses -> a1 -> Rule m a2 a1 -> m r) -> m r
forall r.
Accesses -> a2 -> (Accesses -> a1 -> Rule m a2 a1 -> m r) -> m r
g Accesses
s a2
a \Accesses
s' a1
b Rule m a2 a1
g' -> Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
f Accesses
s' a1
b \Accesses
s'' b
c Rule m a1 b
f' -> Accesses -> b -> Rule m a2 b -> m r
k Accesses
s'' b
c (Rule m a1 b
f' Rule m a1 b -> Rule m a2 a1 -> Rule m a2 b
forall (m :: * -> *) a1 b a2.
Rule m a1 b -> Rule m a2 a1 -> Rule m a2 b
`rComp` Rule m a2 a1
g')
{-# INLINEABLE [0] rComp #-}

{-# RULES "associate" forall f g h. f `rComp` (g `rComp` h) = (f `rComp` g) `rComp` h #-}

rId :: Rule m a a
rId :: Rule m a a
rId = (forall r.
 Accesses -> a -> (Accesses -> a -> Rule m a a -> m r) -> m r)
-> Rule m a a
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a
a Accesses -> a -> Rule m a a -> m r
k -> Accesses -> a -> Rule m a a -> m r
k Accesses
s a
a Rule m a a
forall (m :: * -> *) a. Rule m a a
rId
{-# INLINEABLE [0] rId #-}
#ifndef __HLINT__
{-# RULES
"f/id" forall f. f `rComp` rId = f
"id/f" forall f. rId `rComp` f = f
#-}
#endif

rArr :: (a -> b) -> Rule m a b
rArr :: (a -> b) -> Rule m a b
rArr a -> b
f = (forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a
a Accesses -> b -> Rule m a b -> m r
k -> Accesses -> b -> Rule m a b -> m r
k Accesses
s (a -> b
f a
a) ((a -> b) -> Rule m a b
forall a b (m :: * -> *). (a -> b) -> Rule m a b
rArr a -> b
f)
{-# INLINEABLE [0] rArr #-}
#ifndef __HLINT__
{-# RULES
"arr/id"        rArr (\x -> x) = rId
"arr/const" [1] forall x. rArr (\_ -> x) = rPure x
"arr/arr"       forall f g. rArr f `rComp` rArr g = rArr (f . g)
"arr/arr/f"     forall f g h. (f `rComp` rArr g) `rComp` rArr h = f `rComp` rArr (g . h)
#-}
#endif

rArrM :: (Monad m) => (a -> m b) -> Rule m a b
rArrM :: (a -> m b) -> Rule m a b
rArrM a -> m b
f = (forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a
a Accesses -> b -> Rule m a b -> m r
k -> a -> m b
f a
a m b -> (b -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b -> Accesses -> b -> Rule m a b -> m r
k Accesses
s b
b ((a -> m b) -> Rule m a b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Rule m a b
rArrM a -> m b
f)
{-# INLINEABLE [0] rArrM #-}
#ifndef __HLINT__
{-# RULES
"arrM/arrM"   forall f g. rArrM f `rComp` rArrM g = rArrM (f <=< g)
"arr/arrM"    forall f g. rArr f `rComp` rArrM g = rArrM (fmap f . g)
"arrM/arr"    forall f g. rArrM f `rComp` rArr g = rArrM (f . g)
"arrM/arrM/f" forall f g h. (f `rComp` rArrM g) `rComp` rArrM h = f `rComp` rArrM (g <=< h)
"arr/arrM/f"  forall f g h. (f `rComp` rArr g) `rComp` rArrM h = f `rComp` rArrM (fmap g . h)
"arrM/arr/f"  forall f g h. (f `rComp` rArrM g) `rComp` rArr h = f `rComp` rArrM (g . h)
#-}
#endif

rFirst :: Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst :: Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst (Rule forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
r) = (forall r.
 Accesses
 -> (a, b2)
 -> (Accesses -> (b1, b2) -> Rule m (a, b2) (b1, b2) -> m r)
 -> m r)
-> Rule m (a, b2) (b1, b2)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s (a, c) Accesses -> (b1, b2) -> Rule m (a, b2) (b1, b2) -> m r
k -> Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
r Accesses
s a
a \Accesses
s' b1
b Rule m a b1
r' -> Accesses -> (b1, b2) -> Rule m (a, b2) (b1, b2) -> m r
k Accesses
s' (b1
b, b2
c) (Rule m a b1 -> Rule m (a, b2) (b1, b2)
forall (m :: * -> *) a b1 b2.
Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst Rule m a b1
r')
{-# INLINEABLE [0] rFirst #-}
#ifndef __HLINT__
{-# RULES
"first/id"         rFirst rId = rId
"first/arr"        forall f. rFirst (rArr f) = rArr (first f)
"first/arrM"       forall f. rFirst (rArrM f) = rArrM (runKleisli (first (Kleisli f)))
"first/push"  [~1] forall f g. rFirst (f `rComp` g) = rFirst f `rComp` rFirst g
"first/pull"   [1] forall f g. rFirst f `rComp` rFirst g = rFirst (f `rComp` g)
"first/f/pull" [1] forall f g h. (f `rComp` rFirst g) `rComp` rFirst h = f `rComp` rFirst (g `rComp` h)
#-}
#endif

rLeft :: Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
rLeft :: Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
rLeft Rule m a b1
r0 = Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
go Rule m a b1
r0
  where
    go :: Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
go (Rule forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
r) = (forall r.
 Accesses
 -> Either a b2
 -> (Accesses
     -> Either b1 b2 -> Rule m (Either a b2) (Either b1 b2) -> m r)
 -> m r)
-> Rule m (Either a b2) (Either b1 b2)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s Either a b2
e Accesses
-> Either b1 b2 -> Rule m (Either a b2) (Either b1 b2) -> m r
k -> case Either a b2
e of
      Left a -> Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
r Accesses
s a
a \Accesses
s' b1
b Rule m a b1
r' -> Accesses
-> Either b1 b2 -> Rule m (Either a b2) (Either b1 b2) -> m r
k Accesses
s' (b1 -> Either b1 b2
forall a b. a -> Either a b
Left b1
b) (Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
go Rule m a b1
r')
      Right c -> Accesses
-> Either b1 b2 -> Rule m (Either a b2) (Either b1 b2) -> m r
k Accesses
s (b2 -> Either b1 b2
forall a b. b -> Either a b
Right b2
c) (Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
go Rule m a b1
r0)
{-# INLINEABLE [0] rLeft #-}
#ifndef __HLINT__
{-# RULES
"left/id"         rLeft rId = rId
"left/arr"        forall f. rLeft (rArr f) = rArr (left f)
"left/arrM"       forall f. rLeft (rArrM f) = rArrM (runKleisli (left (Kleisli f)))
"left/push"  [~1] forall f g. rLeft (f `rComp` g) = rLeft f `rComp` rLeft g
"left/pull"   [1] forall f g. rLeft f `rComp` rLeft g = rLeft (f `rComp` g)
"left/f/pull" [1] forall f g h. (f `rComp` rLeft g) `rComp` rLeft h = f `rComp` rLeft (g `rComp` h)
#-}
#endif

rPure :: b -> Rule m a b
rPure :: b -> Rule m a b
rPure b
a = (forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a
_ Accesses -> b -> Rule m a b -> m r
k -> Accesses -> b -> Rule m a b -> m r
k Accesses
s b
a (b -> Rule m a b
forall b (m :: * -> *) a. b -> Rule m a b
rPure b
a)
{-# INLINEABLE [0] rPure #-}

{-# RULES "pure/push" [~1] rPure = rArr . const #-} -- see Note [Desugaring derived operations]

rSecond :: Rule m a1 b -> Rule m (a2, a1) (a2, b)
rSecond :: Rule m a1 b -> Rule m (a2, a1) (a2, b)
rSecond (Rule forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
r) = (forall r.
 Accesses
 -> (a2, a1)
 -> (Accesses -> (a2, b) -> Rule m (a2, a1) (a2, b) -> m r)
 -> m r)
-> Rule m (a2, a1) (a2, b)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s (c, a) Accesses -> (a2, b) -> Rule m (a2, a1) (a2, b) -> m r
k -> Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
r Accesses
s a1
a \Accesses
s' b
b Rule m a1 b
r' -> Accesses -> (a2, b) -> Rule m (a2, a1) (a2, b) -> m r
k Accesses
s' (a2
c, b
b) (Rule m a1 b -> Rule m (a2, a1) (a2, b)
forall (m :: * -> *) a1 b a2.
Rule m a1 b -> Rule m (a2, a1) (a2, b)
rSecond Rule m a1 b
r')
{-# INLINEABLE [0] rSecond #-}

-- see Note [Desugaring derived operations]
{-# RULES "second/push" [~1] forall f. rSecond f = rArr swap . rFirst f . rArr swap #-}

swapEither :: Either a b -> Either b a
swapEither :: Either a b -> Either b a
swapEither = (a -> Either b a) -> (b -> Either b a) -> Either a b -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either b a
forall a b. b -> Either a b
Right b -> Either b a
forall a b. a -> Either a b
Left
{-# INLINE [0] swapEither #-}

rRight :: Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
rRight :: Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
rRight Rule m a1 b
r0 = Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
go Rule m a1 b
r0
  where
    go :: Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
go (Rule forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
r) = (forall r.
 Accesses
 -> Either a2 a1
 -> (Accesses
     -> Either a2 b -> Rule m (Either a2 a1) (Either a2 b) -> m r)
 -> m r)
-> Rule m (Either a2 a1) (Either a2 b)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s Either a2 a1
e Accesses
-> Either a2 b -> Rule m (Either a2 a1) (Either a2 b) -> m r
k -> case Either a2 a1
e of
      Left c -> Accesses
-> Either a2 b -> Rule m (Either a2 a1) (Either a2 b) -> m r
k Accesses
s (a2 -> Either a2 b
forall a b. a -> Either a b
Left a2
c) (Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
go Rule m a1 b
r0)
      Right a -> Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
r Accesses
s a1
a \Accesses
s' b
b Rule m a1 b
r' -> Accesses
-> Either a2 b -> Rule m (Either a2 a1) (Either a2 b) -> m r
k Accesses
s' (b -> Either a2 b
forall a b. b -> Either a b
Right b
b) (Rule m a1 b -> Rule m (Either a2 a1) (Either a2 b)
go Rule m a1 b
r')
{-# INLINEABLE [0] rRight #-}

-- see Note [Desugaring derived operations]
{-# RULES "right/push" [~1] forall f. rRight f = rArr swapEither . rLeft f . rArr swapEither #-}

rSplit :: Rule m a1 b1 -> Rule m a2 b2 -> Rule m (a1, a2) (b1, b2)
Rule forall r.
Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
f rSplit :: Rule m a1 b1 -> Rule m a2 b2 -> Rule m (a1, a2) (b1, b2)
`rSplit` Rule forall r.
Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
g =
  (forall r.
 Accesses
 -> (a1, a2)
 -> (Accesses -> (b1, b2) -> Rule m (a1, a2) (b1, b2) -> m r)
 -> m r)
-> Rule m (a1, a2) (b1, b2)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s (a, b) Accesses -> (b1, b2) -> Rule m (a1, a2) (b1, b2) -> m r
k -> Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
f Accesses
s a1
a \Accesses
s' b1
c Rule m a1 b1
f' -> Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
forall r.
Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
g Accesses
s' a2
b \Accesses
s'' b2
d Rule m a2 b2
g' -> Accesses -> (b1, b2) -> Rule m (a1, a2) (b1, b2) -> m r
k Accesses
s'' (b1
c, b2
d) (Rule m a1 b1
f' Rule m a1 b1 -> Rule m a2 b2 -> Rule m (a1, a2) (b1, b2)
forall (m :: * -> *) a1 b1 a2 b2.
Rule m a1 b1 -> Rule m a2 b2 -> Rule m (a1, a2) (b1, b2)
`rSplit` Rule m a2 b2
g')
{-# INLINEABLE [0] rSplit #-}

-- see Note [Desugaring derived operations]
{-# RULES "***/push" [~1] forall f g. f `rSplit` g = rSecond g . rFirst f #-}

rFanout :: Rule m a b1 -> Rule m a b2 -> Rule m a (b1, b2)
Rule forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
f rFanout :: Rule m a b1 -> Rule m a b2 -> Rule m a (b1, b2)
`rFanout` Rule forall r.
Accesses -> a -> (Accesses -> b2 -> Rule m a b2 -> m r) -> m r
g =
  (forall r.
 Accesses
 -> a -> (Accesses -> (b1, b2) -> Rule m a (b1, b2) -> m r) -> m r)
-> Rule m a (b1, b2)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s a
a Accesses -> (b1, b2) -> Rule m a (b1, b2) -> m r
k -> Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
forall r.
Accesses -> a -> (Accesses -> b1 -> Rule m a b1 -> m r) -> m r
f Accesses
s a
a \Accesses
s' b1
b Rule m a b1
f' -> Accesses -> a -> (Accesses -> b2 -> Rule m a b2 -> m r) -> m r
forall r.
Accesses -> a -> (Accesses -> b2 -> Rule m a b2 -> m r) -> m r
g Accesses
s' a
a \Accesses
s'' b2
c Rule m a b2
g' -> Accesses -> (b1, b2) -> Rule m a (b1, b2) -> m r
k Accesses
s'' (b1
b, b2
c) (Rule m a b1
f' Rule m a b1 -> Rule m a b2 -> Rule m a (b1, b2)
forall (m :: * -> *) a b1 b2.
Rule m a b1 -> Rule m a b2 -> Rule m a (b1, b2)
`rFanout` Rule m a b2
g')
{-# INLINEABLE [0] rFanout #-}

-- see Note [Desugaring derived operations]
{-# RULES "&&&/push" [~1] forall f g. f `rFanout` g = (f *** g) . rArr (\a -> (a, a)) #-}

rFork :: Rule m a1 b1 -> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
Rule m a1 b1
f0 rFork :: Rule m a1 b1
-> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
`rFork` Rule m a2 b2
g0 = Rule m a1 b1
-> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
go Rule m a1 b1
f0 Rule m a2 b2
g0
  where
    go :: Rule m a1 b1
-> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
go (Rule forall r.
Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
f) (Rule forall r.
Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
g) = (forall r.
 Accesses
 -> Either a1 a2
 -> (Accesses
     -> Either b1 b2 -> Rule m (Either a1 a2) (Either b1 b2) -> m r)
 -> m r)
-> Rule m (Either a1 a2) (Either b1 b2)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s Either a1 a2
e Accesses
-> Either b1 b2 -> Rule m (Either a1 a2) (Either b1 b2) -> m r
k -> case Either a1 a2
e of
      Left a -> Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b1 -> Rule m a1 b1 -> m r) -> m r
f Accesses
s a1
a \Accesses
s' b1
b Rule m a1 b1
f' -> Accesses
-> Either b1 b2 -> Rule m (Either a1 a2) (Either b1 b2) -> m r
k Accesses
s' (b1 -> Either b1 b2
forall a b. a -> Either a b
Left b1
b) (Rule m a1 b1
-> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
go Rule m a1 b1
f' Rule m a2 b2
g0)
      Right a -> Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
forall r.
Accesses -> a2 -> (Accesses -> b2 -> Rule m a2 b2 -> m r) -> m r
g Accesses
s a2
a \Accesses
s' b2
b Rule m a2 b2
g' -> Accesses
-> Either b1 b2 -> Rule m (Either a1 a2) (Either b1 b2) -> m r
k Accesses
s' (b2 -> Either b1 b2
forall a b. b -> Either a b
Right b2
b) (Rule m a1 b1
-> Rule m a2 b2 -> Rule m (Either a1 a2) (Either b1 b2)
go Rule m a1 b1
f0 Rule m a2 b2
g')
{-# INLINEABLE [0] rFork #-}

-- see Note [Desugaring derived operations]
{-# RULES "+++/push" [~1] forall f g. f `rFork` g = rRight g . rLeft f #-}

fromEither :: Either a a -> a
fromEither :: Either a a -> a
fromEither = (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
{-# INLINE [0] fromEither #-}

rFanin :: Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
Rule m a1 b
f0 rFanin :: Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
`rFanin` Rule m a2 b
g0 = Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
go Rule m a1 b
f0 Rule m a2 b
g0
  where
    go :: Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
go (Rule forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
f) (Rule forall r.
Accesses -> a2 -> (Accesses -> b -> Rule m a2 b -> m r) -> m r
g) = (forall r.
 Accesses
 -> Either a1 a2
 -> (Accesses -> b -> Rule m (Either a1 a2) b -> m r)
 -> m r)
-> Rule m (Either a1 a2) b
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s Either a1 a2
e Accesses -> b -> Rule m (Either a1 a2) b -> m r
k -> case Either a1 a2
e of
      Left a -> Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
forall r.
Accesses -> a1 -> (Accesses -> b -> Rule m a1 b -> m r) -> m r
f Accesses
s a1
a \Accesses
s' b
b Rule m a1 b
f' -> Accesses -> b -> Rule m (Either a1 a2) b -> m r
k Accesses
s' b
b (Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
go Rule m a1 b
f' Rule m a2 b
g0)
      Right a -> Accesses -> a2 -> (Accesses -> b -> Rule m a2 b -> m r) -> m r
forall r.
Accesses -> a2 -> (Accesses -> b -> Rule m a2 b -> m r) -> m r
g Accesses
s a2
a \Accesses
s' b
b Rule m a2 b
g' -> Accesses -> b -> Rule m (Either a1 a2) b -> m r
k Accesses
s' b
b (Rule m a1 b -> Rule m a2 b -> Rule m (Either a1 a2) b
go Rule m a1 b
f0 Rule m a2 b
g')
{-# INLINEABLE [0] rFanin #-}

-- see Note [Desugaring derived operations]
{-# RULES "|||/push" [~1] forall f g. f `rFanin` g = rArr fromEither . (f +++ g) #-}

instance Functor (Rule m a) where
  fmap :: (a -> b) -> Rule m a a -> Rule m a b
fmap a -> b
f Rule m a a
r = (a -> b) -> Rule m a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f Rule m a b -> Rule m a a -> Rule m a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rule m a a
r
  {-# INLINE fmap #-}

instance Applicative (Rule m a) where
  pure :: a -> Rule m a a
pure = a -> Rule m a a
forall b (m :: * -> *) a. b -> Rule m a b
rPure
  {-# INLINE pure #-}
  <*> :: Rule m a (a -> b) -> Rule m a a -> Rule m a b
(<*>) = ((a -> b) -> a -> b)
-> Rule m a (a -> b) -> Rule m a a -> Rule m a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
  {-# INLINE (<*>) #-}
  liftA2 :: (a -> b -> c) -> Rule m a a -> Rule m a b -> Rule m a c
liftA2 a -> b -> c
f Rule m a a
g Rule m a b
h = ((a, b) -> c) -> Rule m (a, b) c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f) Rule m (a, b) c -> Rule m a (a, b) -> Rule m a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Rule m a a
g Rule m a a -> Rule m a b -> Rule m a (a, b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Rule m a b
h)
  {-# INLINE liftA2 #-}

instance Profunctor (Rule m) where
  dimap :: (a -> b) -> (c -> d) -> Rule m b c -> Rule m a d
dimap a -> b
f c -> d
g Rule m b c
r = (c -> d) -> Rule m c d
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr c -> d
g Rule m c d -> Rule m a c -> Rule m a d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rule m b c
r Rule m b c -> Rule m a b -> Rule m a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Rule m a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f
  {-# INLINE dimap #-}
  lmap :: (a -> b) -> Rule m b c -> Rule m a c
lmap a -> b
f Rule m b c
r = Rule m b c
r Rule m b c -> Rule m a b -> Rule m a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> b) -> Rule m a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f
  {-# INLINE lmap #-}
  rmap :: (b -> c) -> Rule m a b -> Rule m a c
rmap = (b -> c) -> Rule m a b -> Rule m a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE rmap #-}

instance Strong (Rule m) where
  first' :: Rule m a b -> Rule m (a, c) (b, c)
first' = Rule m a b -> Rule m (a, c) (b, c)
forall (m :: * -> *) a b1 b2.
Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst
  {-# INLINE first' #-}
  second' :: Rule m a b -> Rule m (c, a) (c, b)
second' = Rule m a b -> Rule m (c, a) (c, b)
forall (m :: * -> *) a1 b a2.
Rule m a1 b -> Rule m (a2, a1) (a2, b)
rSecond
  {-# INLINE second' #-}

instance Choice (Rule m) where
  left' :: Rule m a b -> Rule m (Either a c) (Either b c)
left' = Rule m a b -> Rule m (Either a c) (Either b c)
forall (m :: * -> *) a b c.
Rule m a b -> Rule m (Either a c) (Either b c)
rLeft
  {-# INLINE left' #-}
  right' :: Rule m a b -> Rule m (Either c a) (Either c b)
right' = Rule m a b -> Rule m (Either c a) (Either c b)
forall (m :: * -> *) a b c.
Rule m a b -> Rule m (Either c a) (Either c b)
rRight
  {-# INLINE right' #-}

instance Category (Rule m) where
  id :: Rule m a a
id = Rule m a a
forall (m :: * -> *) a. Rule m a a
rId
  {-# INLINE id #-}
  . :: Rule m b c -> Rule m a b -> Rule m a c
(.) = Rule m b c -> Rule m a b -> Rule m a c
forall (m :: * -> *) a1 b a2.
Rule m a1 b -> Rule m a2 a1 -> Rule m a2 b
rComp
  {-# INLINE (.) #-}

instance Arrow (Rule m) where
  arr :: (b -> c) -> Rule m b c
arr = (b -> c) -> Rule m b c
forall a b (m :: * -> *). (a -> b) -> Rule m a b
rArr
  {-# INLINE arr #-}
  first :: Rule m b c -> Rule m (b, d) (c, d)
first = Rule m b c -> Rule m (b, d) (c, d)
forall (m :: * -> *) a b1 b2.
Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst
  {-# INLINE first #-}
  second :: Rule m b c -> Rule m (d, b) (d, c)
second = Rule m b c -> Rule m (d, b) (d, c)
forall (m :: * -> *) a1 b a2.
Rule m a1 b -> Rule m (a2, a1) (a2, b)
rSecond
  {-# INLINE second #-}
  *** :: Rule m b c -> Rule m b' c' -> Rule m (b, b') (c, c')
(***) = Rule m b c -> Rule m b' c' -> Rule m (b, b') (c, c')
forall (m :: * -> *) a1 b1 a2 b2.
Rule m a1 b1 -> Rule m a2 b2 -> Rule m (a1, a2) (b1, b2)
rSplit
  {-# INLINE (***) #-}
  &&& :: Rule m b c -> Rule m b c' -> Rule m b (c, c')
(&&&) = Rule m b c -> Rule m b c' -> Rule m b (c, c')
forall (m :: * -> *) a b1 b2.
Rule m a b1 -> Rule m a b2 -> Rule m a (b1, b2)
rFanout
  {-# INLINE (&&&) #-}

instance ArrowChoice (Rule m) where
  left :: Rule m b c -> Rule m (Either b d) (Either c d)
left = Rule m b c -> Rule m (Either b d) (Either c d)
forall (m :: * -> *) a b c.
Rule m a b -> Rule m (Either a c) (Either b c)
rLeft
  {-# INLINE left #-}
  right :: Rule m b c -> Rule m (Either d b) (Either d c)
right = Rule m b c -> Rule m (Either d b) (Either d c)
forall (m :: * -> *) a b c.
Rule m a b -> Rule m (Either c a) (Either c b)
rRight
  {-# INLINE right #-}
  +++ :: Rule m b c -> Rule m b' c' -> Rule m (Either b b') (Either c c')
(+++) = Rule m b c -> Rule m b' c' -> Rule m (Either b b') (Either c c')
forall (m :: * -> *) b c b' c'.
Rule m b c -> Rule m b' c' -> Rule m (Either b b') (Either c c')
rFork
  {-# INLINE (+++) #-}
  ||| :: Rule m b d -> Rule m c d -> Rule m (Either b c) d
(|||) = Rule m b d -> Rule m c d -> Rule m (Either b c) d
forall (m :: * -> *) b d c.
Rule m b d -> Rule m c d -> Rule m (Either b c) d
rFanin
  {-# INLINE (|||) #-}

instance (Monad m) => ArrowKleisli m (Rule m) where
  arrM :: (a -> m b) -> Rule m a b
arrM = (a -> m b) -> Rule m a b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Rule m a b
rArrM
  {-# INLINE arrM #-}

class (Arrow arr) => ArrowDistribute arr where
  -- | Distributes an arrow that operates on key-value pairs, over a 'HM.HashMap' in an
  -- order-independent way.
  --
  -- This is intended to be used as a control operator in @proc@ notation; see
  -- Note [Weird control operator types] in "Control.Arrow.Extended".
  keyed ::
    (Eq k, Hashable k) =>
    arr (e, (k, (a, s))) b ->
    arr (e, (HashMap k a, s)) (HashMap k b)

instance (Monoid w, ArrowDistribute arr) => ArrowDistribute (WriterA w arr) where
  keyed :: WriterA w arr (e, (k, (a, s))) b
-> WriterA w arr (e, (HashMap k a, s)) (HashMap k b)
keyed (WriterA arr (e, (k, (a, s))) (b, w)
f) = arr (e, (HashMap k a, s)) (HashMap k b, w)
-> WriterA w arr (e, (HashMap k a, s)) (HashMap k b)
forall w (arr :: * -> * -> *) a b.
(Monoid w, Arrow arr) =>
arr a (b, w) -> WriterA w arr a b
WriterA ((HashMap k (b, w) -> (HashMap k b, w))
-> arr (HashMap k (b, w)) (HashMap k b, w)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((w, HashMap k b) -> (HashMap k b, w)
forall a b. (a, b) -> (b, a)
swap ((w, HashMap k b) -> (HashMap k b, w))
-> (HashMap k (b, w) -> (w, HashMap k b))
-> HashMap k (b, w)
-> (HashMap k b, w)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((b, w) -> (w, b)) -> HashMap k (b, w) -> (w, HashMap k b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (b, w) -> (w, b)
forall a b. (a, b) -> (b, a)
swap) arr (HashMap k (b, w)) (HashMap k b, w)
-> arr (e, (HashMap k a, s)) (HashMap k (b, w))
-> arr (e, (HashMap k a, s)) (HashMap k b, w)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. arr (e, (k, (a, s))) (b, w)
-> arr (e, (HashMap k a, s)) (HashMap k (b, w))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
keyed arr (e, (k, (a, s))) (b, w)
f)
  {-# INLINE keyed #-}

-- | Unlike 'traverseA', using 'keyed' preserves incrementalization: if the input rule is
-- incremental in its argument, the resulting rule will be incremental as well for any entries in
-- the map that do not change between builds.
instance ArrowDistribute (Rule m) where
  keyed ::
    forall a b k e s.
    (Eq k, Hashable k) =>
    Rule m (e, (k, (a, s))) b ->
    Rule m (e, (HashMap k a, s)) (HashMap k b)
  keyed :: Rule m (e, (k, (a, s))) b
-> Rule m (e, (HashMap k a, s)) (HashMap k b)
keyed Rule m (e, (k, (a, s))) b
r0 = HashMap k (Rule m (e, (k, (a, s))) b)
-> Rule m (e, (HashMap k a, s)) (HashMap k b)
keyedWith HashMap k (Rule m (e, (k, (a, s))) b)
forall k v. HashMap k v
HM.empty
    where
      keyedWith ::
        HashMap k (Rule m (e, (k, (a, s))) b) ->
        Rule m (e, (HashMap k a, s)) (HashMap k b)
      keyedWith :: HashMap k (Rule m (e, (k, (a, s))) b)
-> Rule m (e, (HashMap k a, s)) (HashMap k b)
keyedWith !HashMap k (Rule m (e, (k, (a, s))) b)
rs = (forall r.
 Accesses
 -> (e, (HashMap k a, s))
 -> (Accesses
     -> HashMap k b
     -> Rule m (e, (HashMap k a, s)) (HashMap k b)
     -> m r)
 -> m r)
-> Rule m (e, (HashMap k a, s)) (HashMap k b)
forall (m :: * -> *) a b.
(forall r.
 Accesses -> a -> (Accesses -> b -> Rule m a b -> m r) -> m r)
-> Rule m a b
Rule \Accesses
s (e, (vs, sk)) Accesses
-> HashMap k b -> Rule m (e, (HashMap k a, s)) (HashMap k b) -> m r
c ->
        (k
 -> a
 -> (Accesses
     -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r)
 -> Accesses
 -> HashMap k b
 -> HashMap k (Rule m (e, (k, (a, s))) b)
 -> m r)
-> (Accesses
    -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r)
-> HashMap k a
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey (HashMap k (Rule m (e, (k, (a, s))) b)
-> e
-> s
-> k
-> a
-> (Accesses
    -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
forall r.
HashMap k (Rule m (e, (k, (a, s))) b)
-> e
-> s
-> k
-> a
-> (Accesses
    -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
process HashMap k (Rule m (e, (k, (a, s))) b)
rs e
e s
sk) ((Accesses
 -> HashMap k b
 -> Rule m (e, (HashMap k a, s)) (HashMap k b)
 -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
forall r.
(Accesses
 -> HashMap k b
 -> Rule m (e, (HashMap k a, s)) (HashMap k b)
 -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
finish Accesses
-> HashMap k b -> Rule m (e, (HashMap k a, s)) (HashMap k b) -> m r
c) HashMap k a
vs Accesses
s HashMap k b
forall k v. HashMap k v
HM.empty HashMap k (Rule m (e, (k, (a, s))) b)
forall k v. HashMap k v
HM.empty

      process ::
        HashMap k (Rule m (e, (k, (a, s))) b) ->
        e ->
        s ->
        k ->
        a ->
        (Accesses -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r) ->
        Accesses ->
        HashMap k b ->
        HashMap k (Rule m (e, (k, (a, s))) b) ->
        m r
      process :: HashMap k (Rule m (e, (k, (a, s))) b)
-> e
-> s
-> k
-> a
-> (Accesses
    -> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
process HashMap k (Rule m (e, (k, (a, s))) b)
rs e
e s
sk k
k a
a Accesses
-> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r
c Accesses
s !HashMap k b
vs' !HashMap k (Rule m (e, (k, (a, s))) b)
rs' =
        let Rule forall r.
Accesses
-> (e, (k, (a, s)))
-> (Accesses -> b -> Rule m (e, (k, (a, s))) b -> m r)
-> m r
r = Rule m (e, (k, (a, s))) b
-> k
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> Rule m (e, (k, (a, s))) b
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault Rule m (e, (k, (a, s))) b
r0 k
k HashMap k (Rule m (e, (k, (a, s))) b)
rs
         in Accesses
-> (e, (k, (a, s)))
-> (Accesses -> b -> Rule m (e, (k, (a, s))) b -> m r)
-> m r
forall r.
Accesses
-> (e, (k, (a, s)))
-> (Accesses -> b -> Rule m (e, (k, (a, s))) b -> m r)
-> m r
r Accesses
s (e
e, (k
k, (a
a, s
sk))) \Accesses
s' b
b Rule m (e, (k, (a, s))) b
r' -> Accesses
-> HashMap k b -> HashMap k (Rule m (e, (k, (a, s))) b) -> m r
c Accesses
s' (k -> b -> HashMap k b -> HashMap k b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
k b
b HashMap k b
vs') (k
-> Rule m (e, (k, (a, s))) b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> HashMap k (Rule m (e, (k, (a, s))) b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
k Rule m (e, (k, (a, s))) b
r' HashMap k (Rule m (e, (k, (a, s))) b)
rs')

      finish ::
        (Accesses -> HashMap k b -> Rule m (e, (HashMap k a, s)) (HashMap k b) -> m r) ->
        Accesses ->
        HashMap k b ->
        HashMap k (Rule m (e, (k, (a, s))) b) ->
        m r
      finish :: (Accesses
 -> HashMap k b
 -> Rule m (e, (HashMap k a, s)) (HashMap k b)
 -> m r)
-> Accesses
-> HashMap k b
-> HashMap k (Rule m (e, (k, (a, s))) b)
-> m r
finish Accesses
-> HashMap k b -> Rule m (e, (HashMap k a, s)) (HashMap k b) -> m r
c Accesses
s !HashMap k b
vs' !HashMap k (Rule m (e, (k, (a, s))) b)
rs' = Accesses
-> HashMap k b -> Rule m (e, (HashMap k a, s)) (HashMap k b) -> m r
c Accesses
s HashMap k b
vs' (HashMap k (Rule m (e, (k, (a, s))) b)
-> Rule m (e, (HashMap k a, s)) (HashMap k b)
keyedWith HashMap k (Rule m (e, (k, (a, s))) b)
rs')
  {-# INLINEABLE keyed #-}