Created
March 15, 2023 19:23
-
-
Save ramirez7/f1309264e58aa31f12be3532d43f3d09 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Here are some examples from Nuclear Puzzle Defense (our Ludum Dare 49 entry):
In this one, we query
apecsstate for the number of tiles in the grid:2022-09-07-ghci-game-2022-09-07_15.07.20.mp4
And here, we modify
apecsstate 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