github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

🔥 TransC.

Browse Source
This commit is contained in:
Rob Rix 2019-07-15 12:51:37 -04:00
parent a69c34e57e
commit e135751ecc
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 5 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
semantic-core/src/Control/Effect/Readline.hs
View File

@ -11,7 +11,6 @@ module Control.Effect.Readline
, ReadlineC (..)
, runReadline
, runReadlineWithHistory
, TransC (..)
, ControlIOC (..)
, runControlIO
) where
@ -19,8 +18,8 @@ module Control.Effect.Readline
import Prelude hiding (print)
import Control.Effect.Carrier
import Control.Effect.Lift
import Control.Effect.Reader
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Int
@ -58,15 +57,15 @@ newtype Line = Line Int64
increment :: Line -> Line
increment (Line n) = Line (n + 1)
newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (TransC InputT m) a }
newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
deriving newtype (Applicative, Functor, Monad, MonadIO)
runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
runReadline prefs settings = runInputTWithPrefs prefs settings . runTransC . runReader (Line 0) . runReadlineC
runReadline prefs settings = runInputTWithPrefs prefs settings . runM . runReader (Line 0) . runReadlineC
instance (Carrier sig m, Effect sig, MonadException m, MonadIO m) => Carrier (Readline :+: sig) (ReadlineC m) where
instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
eff (L (Prompt prompt k)) = ReadlineC $ do
str <- lift (TransC (getInputLine (cyan <> prompt <> plain)))
str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
local increment (runReadlineC (k str))
where cyan = "\ESC[1;36m\STX"
plain = "\ESC[0m\STX"
@ -88,12 +87,6 @@ runReadlineWithHistory block = do
runReadline prefs settings block
-- | Promote a monad transformer into an effect.
newtype TransC t (m :: * -> *) a = TransC { runTransC :: t m a }
deriving newtype (Applicative, Functor, Monad, MonadIO, MonadTrans)
instance (Carrier sig m, Effect sig, Monad (t m), MonadTrans t) => Carrier sig (TransC t m) where
eff = TransC . join . lift . eff . handle (pure ()) (pure . (runTransC =<<))
runControlIO :: (forall x . m x -> IO x) -> ControlIOC m a -> m a
runControlIO handler = runReader (Handler handler) . runControlIOC