github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-06 23:46:21 +03:00
Code Issues Projects Releases Wiki Activity

🔥 Control.Effect.REPL.

Browse Source
This commit is contained in:
Patrick Thomson 2019-05-08 11:04:33 -04:00
parent 46bcc03437
commit ec03076cf1
1 changed files with 4 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Control/Effect/REPL.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-} {-# LANGUAGE DeriveAnyClass, DerivingStrategies, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-}
module Control.Effect.REPL module Control.Effect.REPL
( REPL (..) ( REPL (..)
@ -20,14 +20,8 @@ import qualified Data.Text as T
data REPL (m :: * -> *) k data REPL (m :: * -> *) k
= Prompt Text (Maybe Text -> k) = Prompt Text (Maybe Text -> k)
| Output Text k | Output Text k
deriving (Functor) deriving stock Functor
deriving anyclass (HFunctor, Effect)
instance HFunctor REPL where
hmap _ = coerce
instance Effect REPL where
handle state handler (Prompt p k) = Prompt p (handler . (<$ state) . k)
handle state handler (Output s k) = Output s (handler (k <$ state))
prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text) prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text)
prompt p = send (Prompt p pure) prompt p = send (Prompt p pure)
@ -39,7 +33,7 @@ runREPL :: Prefs -> Settings IO -> REPLC m a -> m a
runREPL prefs settings = runReader (prefs, settings) . runREPLC runREPL prefs settings = runReader (prefs, settings) . runREPLC
newtype REPLC m a = REPLC { runREPLC :: ReaderC (Prefs, Settings IO) m a } newtype REPLC m a = REPLC { runREPLC :: ReaderC (Prefs, Settings IO) m a }
deriving (Functor, Applicative, Monad, MonadIO) deriving newtype (Functor, Applicative, Monad, MonadIO)
instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where
eff (L op) = do eff (L op) = do