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

Line is an implementation detail.

Browse Source
This commit is contained in:
Rob Rix 2019-10-10 15:40:01 -04:00
parent 5f7ecbdd04
commit de154040c9
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 9 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
semantic-core/src/Control/Carrier/Readline/Haskeline.hs
View File

@ -49,7 +49,7 @@ newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT
instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
eff (L (Prompt prompt k)) = ReadlineC $ do
str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
line <- ask
Line line <- ask
local increment (runReadlineC (k line str))
where cyan = "\ESC[1;36m\STX"
plain = "\ESC[0m\STX"
@ -77,3 +77,9 @@ instance (Carrier sig m, MonadIO m) => MonadException (ControlIOC m) where
controlIO f = ControlIOC $ do
handler <- ask
liftIO (f (RunIO (fmap pure . runHandler handler)) >>= runHandler handler)
newtype Line = Line Int
increment :: Line -> Line
increment (Line n) = Line (n + 1)

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

@ -5,9 +5,6 @@ module Control.Effect.Readline
, prompt
, print
, println
-- * Line numbering
, Line (..)
, increment
-- * Re-exports
, Carrier
) where
@ -20,7 +17,7 @@ import GHC.Generics (Generic1)
import Prelude hiding (print)
data Readline m k
= Prompt String (Line -> Maybe String -> m k)
= Prompt String (Int -> Maybe String -> m k)
| Print (Doc AnsiStyle) (m k)
deriving (Functor, Generic1)
@ -28,7 +25,7 @@ instance HFunctor Readline
instance Effect Readline
prompt :: (IsString str, Member Readline sig, Carrier sig m) => String -> m (Line, Maybe str)
prompt :: (IsString str, Member Readline sig, Carrier sig m) => String -> m (Int, Maybe str)
prompt p = fmap (fmap fromString) <$> send (Prompt p (curry pure))
print :: (Carrier sig m, Member Readline sig) => Doc AnsiStyle -> m ()
@ -36,9 +33,3 @@ print s = send (Print s (pure ()))
println :: (Carrier sig m, Member Readline sig) => Doc AnsiStyle -> m ()
println s = print s >> print "\n"
newtype Line = Line Int
increment :: Line -> Line
increment (Line n) = Line (n + 1)