Using a custom monad stack and effects

[Kleidukos]

In my adventures with Rock I find myself getting some conflicts while using Effectful. It would appear that everything must run in a Task, but it's not clear to me how make use of the polymorphism granted by MonadFetch (which seems to be an MTL-style typeclass).

For reference, I'd like my ideal query interpreter to have this shape:

rules
  :: (Rock :> es, IOE :> es, FileSystem :> es)
  => Query a
  -> Eff es a

As you can see, it itself must be able to use fetch, so I need the Rock constraint.

Is this something that you had to solve when writing runTask? I see rules used multiple times:

runTask :: Rules f -> Task f a -> IO a
runTask rules (Task task) =
  runReaderT task $ Fetch $ runTask rules . rules

Is the idea to re-run rules on the first result in order to get the final action?

[Kleidukos]

For reference, my PR is at https://github.com/Kleidukos/boreal/pull/43/files#diff-f38750059d2398b8d0c68ae531de1803805aba805d871e263975d7e969b00763R28-R37.

[Kleidukos]

@ollef Ultimately I went with the following:

runQuery :: (IOE :> es) => Query a -> Eff es a
runQuery query = liftIO $ 
  Rock.runTask rules $ Rock.fetch query

Which hides that there are filesystem operations happening during rule evaluation, but this will have to suffice.

[ollef]

It does seem like Rock could be formulated as effects instead of the MTL-style type + class that is there today, but it's possible that this would mean a rewrite/fork of the library.

On the other hand, if there's a satisfactory way to create an adapter between Rock's MTL-style effects and other libraries, maybe this isn't necessary. I'd be interested to hear if there's anything that can be be done from Rock's side that would enable this.

One obvious generalization would be to untie Rock from IO as the base type and make Task a monad transformer, but I don't know if that would help this specific case (and I've personally not actually felt the need for this).

Specific questions:

runTask :: Rules f -> Task f a -> IO a
runTask rules (Task task) =
  runReaderT task $ Fetch $ runTask rules . rules

Is the idea to re-run rules on the first result in order to get the final action?

It's about running rules on the queries that the tasks returned from rules perform. The rightmost use of rules takes care of the queries performed by task, i.e. a "first layer" of queries. But rules returns Tasks that may themselves perform queries, which need to be recursively run with runTask rules to bring them down to IO.

@ollef Ultimately I went with the following:

runQuery :: (IOE :> es) => Query a -> Eff es a
runQuery query = liftIO $ 
  Rock.runTask rules $ Rock.fetch query

Which hides that there are filesystem operations happening during rule evaluation, but this will have to suffice.

If this is the way you perform a query from outside Rock's rule and task world (i.e. this function is not used to fetch queries inside rules, but rather in a compiler "driver" or similar) this seems fine, but if it's used inside rules it will prevent Rock from tracking dependencies between queries.

[Kleidukos]

First of all, thanks for being open to the idea.

Effectful's main strength is that it interfaces very well with existing models, so you don't need to change how Rock is implemented too much, because we have a middle ground that we can both reach. :)

See https://hackage.haskell.org/package/effectful-core-2.3.1.0/docs/Effectful.html#g:2

Maybe I am just an idiot and I couldn't see the anchor points of Rock when using Effectful!

---

If this is the way you perform a query from outside Rock's rule and task world (i.e. this function is not used to fetch queries inside rules, but rather in a compiler "driver" or similar) this seems fine, but if it's used inside rules it will prevent Rock from tracking dependencies between queries.

Oh. So the act of reading the file to parse it has to be somehow abstracted? I am not sure how to understand what you just said. :)

[ollef]

Oh. So the act of reading the file to parse it has to be somehow abstracted? I am not sure how to understand what you just said. :)

A lot of Rock's functionality works by "instrumenting" the fetch function passed to each rule, i.e. the Fetch f in:

newtype Task f a = Task { unTask :: ReaderT (Fetch f) IO a }

We can e.g. add memoization by making the Fetch f first lookup the query in a cache to see if it's already been computed before calling rules.

By using runQuery instead of fetch, I think you'll have a hard time using some of the rules transformers like memoise or verifyTraces. memoise might actually work if you bake it into the rules that you pass to runTask and use the same IORef each time (the first argument to memoise), but e.g. verifyTraces works by locally changing the Fetch f for each query to keep track of its dependencies.

[expipiplus1]

This comes out hilariously/suspiciously simply with Effectful

(everything's here https://gist.github.com/expipiplus1/cfd5c4fb4a5a40338ccf8642fb3d0f1e, but below are the choice bits)

type Rules f = forall a es. (f es a -> Eff es a)

data Rock (f :: [Effect] -> Type -> Type) :: Effect
type instance DispatchOf (Rock f) = Static NoSideEffects
newtype instance StaticRep (Rock f) = Rock (forall a es. f es a -> Eff es a)

runRock :: Rules f -> Eff (Rock f : es) a -> Eff es a
runRock r = evalStaticRep (Rock r)

fetch :: (Subset xs es, Rock f :> es) => f xs a -> Eff es a
fetch key = do
  Rock f <- getStaticRep
  inject (f key)

Queries now look like this, where each key declares exactly what it does, including which other query types it might depend on. TBH this is probably just gonna always be Query MyHeapOfUsualEffects a as it gets annoying to have to respecify everything used down to the leaves.

data Query es a where
  QueryInt :: Query '[Rock Query, IOE, Rock Query2] Int
  QueryString :: Query '[IOE] String
  
data Query2 es a where
  Query2Bool :: Query2 '[] Bool

Rules are largely the same, but see how nice it is to fetch from another query type:

testRules :: Rules Query
testRules = \case
  QueryInt -> do
    s <- fetch QueryString
    s2 <- fetch QueryString
    b <- fetch (Query2Bool False)
    pure (length (if b then s else s2))
  QueryString -> do
    sayErr "Querying String"
    pure "hello"

test2Rules :: Rules Query2
test2Rules = \case
  Query2Bool b -> pure (not b)

Running it all is as expected, introduce the rules and run the query

test :: (IOE :> es) => Eff es Int
test = runRock testRules . runRock test2Rules $ fetch QueryInt

Memoisation can be done explicitly, where any memoised calls are made through a wrapper query (which has the same effects as what it's wrapping plus IO to drive the memo machinery.

data MemoQuery f es a where
  MemoQuery :: f es a -> MemoQuery f (IOE : es) a

-- Don't actually memoise anything
withoutMemoisation :: Rules f -> Rules (MemoQuery f)
withoutMemoisation r (MemoQuery key) = raise $ r key

memoiseExplicit
  :: forall f
   . (forall es. GEq (f es), forall es a. Hashable (f es a))
  => IORef (DHashMap (HideEffects f) MVar)
  -> Rules f
  -> Rules (MemoQuery f)
  ...

testExplicitMemo :: Rules Query
testExplicitMemo = \case
  QueryInt -> do
    s <- fetch (MemoQuery QueryString)
    s' <- fetch (MemoQuery QueryString)
    pure (length (s <> s'))
  QueryString -> do
    sayErr "Querying String"
    pure "hello"

Or, if all the queries depend on IO, we can implicitly memoise the whole thing:

-- | Proof that every key permits IO
class HasIOE f where
  withIOE :: f es a -> (IOE :> es => Eff es a) -> Eff es a

memoise
  :: forall f
   . (forall es. GEq (f es), forall es a. Hashable (f es a), HasIOE f)
  => IORef (DHashMap (HideEffects f) MVar)
  -> Rules f
  -> Rules f
memoise startedVar rules (key :: f es a) = withIOE key $ do
  maybeValueVar <- DHashMap.lookup (HideEffects key) <$> readIORef startedVar
  case maybeValueVar of
    Nothing -> do
      valueVar <- newEmptyMVar
      join $ atomicModifyIORef startedVar $ \started ->
        case DHashMap.alterLookup (Just . fromMaybe valueVar) (HideEffects key) started of
          (Nothing, started') ->
            ( started'
            , do
                value <- rules key
                putMVar valueVar value
                return value
            )
          (Just valueVar', _started') ->
            (started, readMVar valueVar')
    Just valueVar ->
      readMVar valueVar

testImplicitMemo :: (IOE :> es) => Eff es Int
testImplicitMemo = do
  memMap <- newIORef mempty
  runRock (memoise memMap testRules')
    . runRock test2Rules
    $ fetch QueryInt'

Can also introduce other interesting wrappers for queries, I've not really played about with how these various wrappers compose.

data TimeoutQuery f es a where
  -- | Nothing if the query timed out 
  TimeoutQuery :: f es a -> TimeoutQuery f (Timeout : es) (Maybe a)

timeoutRules :: Rules f -> Rules (TimeoutQuery f)
timeoutRules r (TimeoutQuery k) =  timeout 1000000 (inject (r k))

Tracking by wrapping the fetch function works pretty similarly

trackM
  :: forall f es k g a
   . (GEq k, Hashable (Some k), IOE :> es, Rock f :> es)
  => (forall es' a'. f es' a' -> a' -> Eff es' (k a', g a'))
  -> Eff es a
  -> Eff es (a, DHashMap k g)
trackM f task = do
  depsVar <- newIORef mempty
  let
    record'
      :: ( (forall a' es'. f es' a' -> Eff es' a')
           -> (forall a' es'. (IOQuery f) es' a' -> Eff es' a')
         )
    record' fetch' (IOQuery key) = do
      value <- raise $ fetch' key
      (k, g) <- raise $ f key value
      atomicModifyIORef depsVar $ (,()) . DHashMap.insert k g
      pure value
  result <- transRock record' (raise task)
  deps <- readIORef depsVar
  return (result, deps)

[Kleidukos]

@expipiplus1 wow this is fantastic work! Thank you so much!

[ollef]

Very cool! 🙌