ghci-pipe.hs

{-# LANGUAGE TemplateHaskell #-}
module Mayhem.Engine.Effects.GHCi where

import Cleff

import Data.Dynamic
import Data.Typeable
import Control.Concurrent.MVar
import UnliftIO.Exception
import Mayhem.Engine.Effects.Expansion
import Control.Monad.Managed
import Data.Foldable (for_)
import Data.Traversable (for)

data GHCi :: Effect where
  TickGHCi :: GHCi m ()

data GHCiPipe es = GHCiPipe
  { ghciToEngine :: MVar (Eff es Dynamic)
  , ghciFromEngine :: MVar (Either SomeException Dynamic)
  }

newGHCiPipe :: forall es. IO (GHCiPipe es)
newGHCiPipe = GHCiPipe <$> newEmptyMVar <*> newEmptyMVar

exp'GHCiDummy
  :: Applicative m => Expansion m GHCi es
exp'GHCiDummy = \Run{..} ->
  pure $ Run $ run . runGHCiDummy
  where
    runGHCiDummy :: Eff (GHCi : es) ~> Eff es
    runGHCiDummy = interpret $ \case
      TickGHCi -> pure ()

exp'GHCiPipe
  :: Typeable es
  => Applicative m
  => IOE :> es
  => Subset ies es
  => GHCiPipe ies
  -> Expansion m GHCi es
exp'GHCiPipe pipe = \Run{..} -> do
  pure $ Run $ run . runGHCi pipe

runGHCi
  :: forall es ies
   . Typeable es
  => Subset ies es
  => IOE :> es
  => GHCiPipe ies
  -> (Eff (GHCi : es) ~> Eff es)
runGHCi GHCiPipe{..} = interpret $ \case
  TickGHCi -> do
    mEffDyn <- liftIO (tryTakeMVar ghciToEngine)
    res <- traverse (tryAny . inject) mEffDyn
    liftIO $ for_ res (putMVar ghciFromEngine)

sendGHCi
  :: forall a ies
   . Typeable a
  => Typeable ies
  => GHCiPipe ies
  -> Eff ies a
  -> IO a
sendGHCi GHCiPipe{..} eff = do
  putMVar ghciToEngine (toDyn <$> eff)
  takeMVar ghciFromEngine >>= \case
    Left e -> throwIO e
    Right dynA -> case fromDynamic @a dynA of
      Nothing -> throwString $ unwords
        [ "Type Error! (this shouldn't happen)"
        , "got:", show dynA
        , "expected:", show (typeRep (Proxy @a))
        ]
      Just a -> pure a

-- TH_CODE
makeEffect ''GHCi

Notes:

Expansion is an engine-specific thing. Basically, it's a way to create a new effects interpreter in some m (with the ability to use "lower" effects). The name is meant to evoke old school consoles (e.g. the N64 Expansion Pak). My engine in general is going for that analogy of a virtual "console" you create and run your games on.

data m :~> n = Run { run :: forall a. m a -> n a }

type Expansion m e (es :: [Effect]) = (Eff es :~> m) -> m (Eff (e : es) :~> m)

Usage is simple. In your game loop, you call tickGHCi once per frame to yield to the repl. And when you run your game in ghci, you can have it return the pipe it is using so you can send arbitrary commands over.

One "tricky" part is you have to be explicit about which effects you expose to ghci, and they have to be "lower" in the effects stack. There may be a way to make this nicer, but it works for now so I haven't bothered :)

Here are some examples from Nuclear Puzzle Defense (our Ludum Dare 49 entry):

In this one, we query apecs state for the number of tiles in the grid:

2022-09-07-ghci-game-2022-09-07_15.07.20.mp4

And here, we modify apecs state to set every tile to a radioactive one, which causes them to merge:

2022-09-07-ghci-game-modify-2022-09-07_15.42.51.mp4

Neat!