fused-effects-readline 0.1.0.1 → 0.2.0.0

raw patch · 4 files changed

+106/−63 lines, 4 filesdep −prettyprinterdep −prettyprinter-ansi-terminaldep −terminal-sizedep ~filepathdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies removed: prettyprinter, prettyprinter-ansi-terminal, terminal-size

Dependency ranges changed: filepath, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• fused-effects-readline.cabal +4/−6
• src/Control/Carrier/Readline/Haskeline.hs +43/−43
• src/Control/Effect/Readline.hs +42/−14

@@ -1,3 +1,20 @@+# v0.2.0.0++- Removes `prettyprinter` dependency.++- Removes the styling applied to prompts; users can add styling to the prompt for themselves if so desired.++- Removes line number tracking.++- Removes `print` in favour of `outputStr` & `outputStrLn`.++- Renames `prompt` to `getInputLine`, matching `haskeline`’s naming.++- Defines `getInputLineWithInitial`, `getInputChar`, `getPassword`, etc. operations matching `haskeline`’s API.++- Allows other effects to be lifted through `ReadlineC` on `haskeline` 0.8.1 or later. ([#3](https://github.com/fused-effects/fused-effects-readline/issues/3))++ # v0.1.0.1  - Support for `prettyprinter` 1.7.

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                fused-effects-readline-version:             0.1.0.1+version:             0.2.0.0 synopsis:            A readline-like effect and carrier for fused-effects description:         A readline-like effect and carrier for fused-effects, using haskeline under the hood homepage:            https://github.com/fused-effects/fused-effects-readline@@ -20,6 +20,7 @@   GHC == 8.6.5   GHC == 8.8.3   GHC == 8.10.1+  GHC == 9.12.1  common common   default-language: Haskell2010@@ -52,13 +53,10 @@   build-depends:     , base >= 4.12 && < 5     , directory ^>= 1.3-    , filepath ^>= 1.4+    , filepath >= 1.4 && <1.6     , fused-effects ^>= 1.1     , haskeline >= 0.7 && < 0.9-    , prettyprinter >= 1.5 && <1.8-    , prettyprinter-ansi-terminal ^>= 1.1-    , terminal-size ^>= 0.3-    , transformers >= 0.4 && < 0.6+    , transformers >= 0.4 && < 0.7   if impl(ghc >= 8.10)     build-depends:       , exceptions ^>= 0.10

@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} module Control.Carrier.Readline.Haskeline ( -- * Readline carrier@@ -15,8 +16,6 @@ ) where  import Control.Algebra-import Control.Carrier.Lift-import Control.Carrier.Reader import Control.Effect.Readline #if MIN_VERSION_haskeline(0, 8, 0) import Control.Monad.Catch (MonadMask(..))@@ -24,21 +23,17 @@ import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..))-import Data.Text.Prettyprint.Doc-import Data.Text.Prettyprint.Doc.Render.Terminal-import System.Console.Haskeline-import System.Console.Terminal.Size as Size+import System.Console.Haskeline as H import System.Directory import System.Environment import System.FilePath-import System.IO (stdout)  #if MIN_VERSION_haskeline(0, 8, 0) runReadline :: (MonadIO m, MonadMask m) => Prefs -> Settings m -> ReadlineC m a -> m a #else runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a #endif-runReadline prefs settings (ReadlineC m) = runInputTWithPrefs prefs settings (runM (runReader (Line 0) m))+runReadline prefs settings (ReadlineC m) = runInputTWithPrefs prefs settings m  #if MIN_VERSION_haskeline(0, 8, 0) runReadlineWithHistory :: (MonadIO m, MonadMask m) => ReadlineC m a -> m a@@ -46,45 +41,50 @@ runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a #endif runReadlineWithHistory block = do-  homeDir <- liftIO getHomeDirectory-  prefs   <- liftIO $ readPrefs (homeDir </> ".haskeline")-  prog    <- liftIO getExecutablePath-  let settingsDir = homeDir </> ".local" </> dropExtension (takeFileName prog)-      settings = Settings-        { complete = noCompletion-        , historyFile = Just (settingsDir </> "repl_history")-        , autoAddHistory = True-        }-  liftIO $ createDirectoryIfMissing True settingsDir+  (prefs, settings) <- liftIO $ do+    homeDir <- getHomeDirectory+    prefs   <- readPrefs (homeDir </> ".haskeline")+    prog    <- getExecutablePath+    let settingsDir = homeDir </> ".local" </> dropExtension (takeFileName prog)+        settings = Settings+          { complete       = noCompletion+          , historyFile    = Just (settingsDir </> "repl_history")+          , autoAddHistory = True+          }+    createDirectoryIfMissing True settingsDir+    pure (prefs, settings)    runReadline prefs settings block -newtype ReadlineC m a = ReadlineC (ReaderC Line (LiftC (InputT m)) a)-  deriving (Applicative, Functor, Monad, MonadFix, MonadIO)--instance MonadTrans ReadlineC where-  lift = ReadlineC . lift . lift . lift+newtype ReadlineC m a = ReadlineC { runReadlineC :: InputT m a }+  deriving (Applicative, Functor, Monad, MonadFix, MonadIO, MonadTrans) +#if MIN_VERSION_haskeline(0, 8, 1)+instance (Algebra sig m, MonadIO m, MonadMask m) => Algebra (Readline :+: sig) (ReadlineC m) where+  alg hdl sig ctx = case sig of+    L readline -> case readline of+      GetInputLine prompt -> (<$ ctx) <$> ReadlineC (H.getInputLine prompt)+      GetInputLineWithInitial prompt lr -> (<$ ctx) <$> ReadlineC (H.getInputLineWithInitial prompt lr)+      GetInputChar prompt -> (<$ ctx) <$> ReadlineC (H.getInputChar prompt)+      GetPassword c prompt -> (<$ ctx) <$> ReadlineC (H.getPassword c prompt)+      WaitForAnyKey prompt -> (<$ ctx) <$> ReadlineC (H.waitForAnyKey prompt)+      OutputStr s -> (<$ ctx) <$> ReadlineC (H.outputStr s)+      WithInterrupt m -> ReadlineC (H.withInterrupt (runReadlineC (hdl (m <$ ctx))))+      HandleInterrupt h m -> ReadlineC (H.handleInterrupt (runReadlineC (hdl (h <$ ctx))) (runReadlineC (hdl (m <$ ctx))))+    R other -> ReadlineC $ H.withRunInBase $ \ run -> alg (run . runReadlineC . hdl) other ctx+#else #if MIN_VERSION_haskeline(0, 8, 0) instance (MonadIO m, MonadMask m) => Algebra Readline (ReadlineC m) where #else instance MonadException m => Algebra Readline (ReadlineC m) where #endif-  alg _ sig ctx = case sig of-    Prompt prompt -> ReadlineC $ do-      str <- sendM (getInputLine @m (cyan <> prompt <> plain))-      Line line <- ask-      local increment $ pure ((line, str) <$ ctx)-      where cyan = "\ESC[1;36m\STX"-            plain = "\ESC[0m\STX"-    Print doc -> do-      s <- maybe 80 Size.width <$> liftIO size-      let docstream = layoutSmart (layoutOptions s) (doc <> line)-      (<$ ctx) <$> (liftIO . renderIO stdout $ docstream)-      where layoutOptions s = defaultLayoutOptions { layoutPageWidth = AvailablePerLine s 0.8 }---newtype Line = Line Int--increment :: Line -> Line-increment (Line n) = Line (n + 1)+  alg hdl sig ctx = case sig of+    GetInputLine prompt -> (<$ ctx) <$> ReadlineC (H.getInputLine prompt)+    GetInputLineWithInitial prompt lr -> (<$ ctx) <$> ReadlineC (H.getInputLineWithInitial prompt lr)+    GetInputChar prompt -> (<$ ctx) <$> ReadlineC (H.getInputChar prompt)+    GetPassword c prompt -> (<$ ctx) <$> ReadlineC (H.getPassword c prompt)+    WaitForAnyKey prompt -> (<$ ctx) <$> ReadlineC (H.waitForAnyKey prompt)+    OutputStr s -> (<$ ctx) <$> ReadlineC (H.outputStr s)+    WithInterrupt m -> ReadlineC (H.withInterrupt (runReadlineC (hdl (m <$ ctx))))+    HandleInterrupt h m -> ReadlineC (H.handleInterrupt (runReadlineC (hdl (h <$ ctx))) (runReadlineC (hdl (m <$ ctx))))+#endif

@@ -1,10 +1,16 @@ {-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-} module Control.Effect.Readline ( -- * Readline effect   Readline(..)-, prompt-, print+, getInputLine+, getInputLineWithInitial+, getInputChar+, getPassword+, waitForAnyKey+, outputStr+, outputStrLn+, withInterrupt+, handleInterrupt   -- * Re-exports , Algebra , Has@@ -12,18 +18,40 @@ ) where  import Control.Algebra-import Data.Kind (Type)-import Data.Text.Prettyprint.Doc (Doc)-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)-import Prelude hiding (print) -prompt :: Has Readline sig m => String -> m (Int, Maybe String)-prompt p = send (Prompt p)+getInputLine :: Has Readline sig m => String -> m (Maybe String)+getInputLine p = send (GetInputLine p) -print :: Has Readline sig m => Doc AnsiStyle -> m ()-print s = send (Print s)+getInputLineWithInitial :: Has Readline sig m => String -> (String, String) -> m (Maybe String)+getInputLineWithInitial p lr = send (GetInputLineWithInitial p lr) +getInputChar :: Has Readline sig m => String -> m (Maybe Char)+getInputChar p = send (GetInputChar p) -data Readline (m :: Type -> Type) (k :: Type) where-  Prompt :: String -> Readline m (Int, Maybe String)-  Print :: Doc AnsiStyle -> Readline m ()+getPassword :: Has Readline sig m => Maybe Char -> String -> m (Maybe String)+getPassword c s = send (GetPassword c s)++waitForAnyKey :: Has Readline sig m => String -> m Bool+waitForAnyKey p = send (WaitForAnyKey p)++outputStr :: Has Readline sig m => String -> m ()+outputStr s = send (OutputStr s)++outputStrLn :: Has Readline sig m => String -> m ()+outputStrLn s = outputStr (s <> "\n")++withInterrupt :: Has Readline sig m => m a -> m a+withInterrupt m = send (WithInterrupt m)++handleInterrupt :: Has Readline sig m => m a -> m a -> m a+handleInterrupt h m = send (HandleInterrupt h m)++data Readline m k where+  GetInputLine :: String -> Readline m (Maybe String)+  GetInputLineWithInitial :: String -> (String, String) -> Readline m (Maybe String)+  GetInputChar :: String -> Readline m (Maybe Char)+  GetPassword :: Maybe Char -> String -> Readline m (Maybe String)+  WaitForAnyKey :: String -> Readline m Bool+  OutputStr :: String -> Readline m ()+  WithInterrupt :: m a -> Readline m a+  HandleInterrupt :: m a -> m a -> Readline m a