repline-0.2.1.0/src/0000755000000000000000000000000013341510266012264 5ustar0000000000000000repline-0.2.1.0/src/System/0000755000000000000000000000000013341510266013550 5ustar0000000000000000repline-0.2.1.0/src/System/Console/0000755000000000000000000000000013462313210015144 5ustar0000000000000000repline-0.2.1.0/src/System/Console/Repline.hs0000644000000000000000000002631313462313210017103 0ustar0000000000000000{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoMonomorphismRestriction #-} {- | Repline exposes an additional monad transformer on top of Haskeline called 'HaskelineT'. It simplifies several aspects of composing Haskeline with State and Exception monads in modern versions of mtl. > type Repl a = HaskelineT IO a The evaluator 'evalRepl' evaluates a 'HaskelineT' monad transformer by constructing a shell with several custom functions and evaluating it inside of IO: * Commands: Handled on ordinary input. * Completions: Handled when tab key is pressed. * Options: Handled when a command prefixed by a prefix character is entered. * Command prefix character: Optional command prefix ( passing Nothing ignores the Options argument ). * Banner: Text Displayed at initialization. * Initializer: Run at initialization. A simple evaluation function might simply echo the output back to the screen. > -- Evaluation : handle each line user inputs > cmd :: String -> Repl () > cmd input = liftIO $ print input Several tab completion options are available, the most common is the 'WordCompleter' which completes on single words separated by spaces from a list of matches. The internal logic can be whatever is required and can also access a StateT instance to query application state. > -- Tab Completion: return a completion for partial words entered > completer :: Monad m => WordCompleter m > completer n = do > let names = ["kirk", "spock", "mccoy"] > return $ filter (isPrefixOf n) names Input which is prefixed by a colon (commands like \":type\" and \":help\") queries an association list of functions which map to custom logic. The function takes a space-separated list of augments in it's first argument. If the entire line is desired then the 'unwords' function can be used to concatenate. > -- Commands > help :: [String] -> Repl () > help args = liftIO $ print $ "Help: " ++ show args > > say :: [String] -> Repl () > say args = do > _ <- liftIO $ system $ "cowsay" ++ " " ++ (unwords args) > return () Now we need only map these functions to their commands. > options :: [(String, [String] -> Repl ())] > options = [ > ("help", help) -- :help > , ("say", say) -- :say > ] The banner function is simply an IO action that is called at the start of the shell. > ini :: Repl () > ini = liftIO $ putStrLn "Welcome!" Putting it all together we have a little shell. > main :: IO () > main = evalRepl (pure ">>> ") cmd options (Just ':') (Word completer) ini Putting this in a file we can test out our cow-trek shell. > $ runhaskell Main.hs > Welcome! > >>> > kirk spock mccoy > > >>> k > kirk > > >>> spam > "spam" > > >>> :say Hello Haskell > _______________ > < Hello Haskell > > --------------- > \ ^__^ > \ (oo)\_______ > (__)\ )\/\ > ||----w | > || || See for more examples. -} module System.Console.Repline ( HaskelineT, runHaskelineT, Cmd, Options, WordCompleter, LineCompleter, CompleterStyle(..), Command, CompletionFunc, -- re-export wordCompleter, listCompleter, fileCompleter, listWordCompleter, runMatcher, evalRepl, abort, tryAction, dontCrash, trimComplete, ) where import System.Console.Haskeline.Completion import System.Console.Haskeline.MonadException import qualified System.Console.Haskeline as H import Data.List (isPrefixOf) import Control.Applicative import Control.Monad.Fail as Fail import Control.Monad.State.Strict import Control.Monad.Reader ------------------------------------------------------------------------------- -- Haskeline Transformer ------------------------------------------------------------------------------- newtype HaskelineT (m :: * -> *) a = HaskelineT { unHaskeline :: H.InputT m a } deriving (Monad, Functor, Applicative, MonadIO, MonadException, MonadTrans, MonadHaskeline) runHaskelineT :: MonadException m => H.Settings m -> HaskelineT m a -> m a runHaskelineT s m = H.runInputT s (H.withInterrupt (unHaskeline m)) class MonadException m => MonadHaskeline m where getInputLine :: String -> m (Maybe String) getInputChar :: String -> m (Maybe Char) outputStr :: String -> m () outputStrLn :: String -> m () instance MonadException m => MonadHaskeline (H.InputT m) where getInputLine = H.getInputLine getInputChar = H.getInputChar outputStr = H.outputStr outputStrLn = H.outputStrLn instance Fail.MonadFail m => Fail.MonadFail (HaskelineT m) where fail = lift . Fail.fail instance MonadState s m => MonadState s (HaskelineT m) where get = lift get put = lift . put instance MonadReader r m => MonadReader r (HaskelineT m) where ask = lift ask local f (HaskelineT m) = HaskelineT $ H.mapInputT (local f) m instance (MonadHaskeline m) => MonadHaskeline (StateT s m) where getInputLine = lift . getInputLine getInputChar = lift . getInputChar outputStr = lift . outputStr outputStrLn = lift . outputStrLn ------------------------------------------------------------------------------- -- Repl ------------------------------------------------------------------------------- type Cmd m = [String] -> m () type Options m = [(String, Cmd m)] type Command m = String -> m () type WordCompleter m = (String -> m [String]) type LineCompleter m = (String -> String -> m [Completion]) -- | Wrap a HasklineT action so that if an interrupt is thrown the shell continues as normal. tryAction :: MonadException m => HaskelineT m a -> HaskelineT m a tryAction (HaskelineT f) = HaskelineT (H.withInterrupt loop) where loop = handle (\H.Interrupt -> loop) f -- | Catch all toplevel failures. dontCrash :: (MonadIO m, H.MonadException m) => m () -> m () dontCrash m = H.catch m ( \ e@SomeException{} -> liftIO ( putStrLn ( show e ) ) ) -- | Abort the current REPL loop, and continue. abort :: MonadIO m => HaskelineT m a abort = throwIO H.Interrupt -- | Completion loop. replLoop :: (Functor m, MonadException m) => HaskelineT m String -> Command (HaskelineT m) -> Options (HaskelineT m) -> Maybe Char -> HaskelineT m () replLoop banner cmdM opts optsPrefix = loop where loop = do prefix <- banner minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix case minput of Nothing -> outputStrLn "Goodbye." Just "" -> loop Just (prefix: cmds) | null cmds -> handleInput [prefix] >> loop | Just prefix == optsPrefix -> case words cmds of [] -> loop (cmd:args) -> do let optAction = optMatcher cmd opts args result <- H.handleInterrupt (return Nothing) $ Just <$> optAction maybe exit (const loop) result Just input -> do handleInput input loop handleInput input = H.handleInterrupt exit $ cmdM input exit = return () -- | Match the options. optMatcher :: MonadHaskeline m => String -> Options m -> [String] -> m () optMatcher s [] _ = outputStrLn $ "No such command :" ++ s optMatcher s ((x, m):xs) args | s `isPrefixOf` x = m args | otherwise = optMatcher s xs args -- | Evaluate the REPL logic into a MonadException context. evalRepl :: (Functor m, MonadException m) -- Terminal monad ( often IO ). => HaskelineT m String -- ^ Banner -> Command (HaskelineT m) -- ^ Command function -> Options (HaskelineT m) -- ^ Options list and commands -> Maybe Char -- ^ Optional command prefix ( passing Nothing ignores the Options argument ) -> CompleterStyle m -- ^ Tab completion function -> HaskelineT m a -- ^ Initializer -> m () evalRepl banner cmd opts optsPrefix comp initz = runHaskelineT _readline (initz >> monad) where monad = replLoop banner cmd opts optsPrefix _readline = H.Settings { H.complete = mkCompleter comp , H.historyFile = Just ".history" , H.autoAddHistory = True } ------------------------------------------------------------------------------- -- Completions ------------------------------------------------------------------------------- --type CompletionFunc m = (String, String) -> m (String, [Completion]) data CompleterStyle m = Word (WordCompleter m) -- ^ Completion function takes single word. | Word0 (WordCompleter m) -- ^ Completion function takes single word ( no space ). | Cursor (LineCompleter m) -- ^ Completion function takes tuple of full line. | File -- ^ Completion function completes files in CWD. | Prefix (CompletionFunc m) [(String, CompletionFunc m)] -- ^ Conditional tab completion based on prefix. mkCompleter :: MonadIO m => CompleterStyle m -> CompletionFunc m mkCompleter (Word f) = completeWord (Just '\\') " \t()[]" (_simpleComplete f) mkCompleter (Word0 f) = completeWord (Just '\\') " \t()[]" (_simpleCompleteNoSpace f) mkCompleter (Cursor f) = completeWordWithPrev (Just '\\') " \t()[]" (unRev0 f) mkCompleter File = completeFilename mkCompleter (Prefix def opts) = runMatcher opts def -- haskeline takes the first argument as the reversed string, don't know why unRev0 :: LineCompleter m -> LineCompleter m unRev0 f x y = f (reverse x) y trimComplete :: String -> Completion -> Completion trimComplete prefix (Completion a b c) = Completion (drop (length prefix) a) b c _simpleComplete :: (Monad m) => (String -> m [String]) -> String -> m [Completion] _simpleComplete f word = f word >>= return . map simpleCompletion _simpleCompleteNoSpace :: (Monad m) => (String -> m [String]) -> String -> m [Completion] _simpleCompleteNoSpace f word = f word >>= return . map completionNoSpace completionNoSpace :: String -> Completion completionNoSpace str = Completion str str False wordCompleter :: Monad m => WordCompleter m -> CompletionFunc m wordCompleter f (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete f) (start, n) listCompleter :: Monad m => [String] -> CompletionFunc m listCompleter names (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete (complete_aux names)) (start, n) listWordCompleter :: Monad m => [String] -> WordCompleter m listWordCompleter = complete_aux fileCompleter :: MonadIO m => CompletionFunc m fileCompleter = completeFilename complete_aux :: Monad m => [String] -> WordCompleter m complete_aux names n = return $ filter (isPrefixOf n) names completeMatcher :: (Monad m) => CompletionFunc m -> String -> [(String, CompletionFunc m)] -> CompletionFunc m completeMatcher def _ [] args = def args completeMatcher def [] _ args = def args completeMatcher def s ((x, f):xs) args | x `isPrefixOf` s = f args | otherwise = completeMatcher def s xs args runMatcher :: Monad m => [(String, CompletionFunc m)] -> CompletionFunc m -> CompletionFunc m runMatcher opts def (start, n) = completeMatcher def (n ++ reverse start) opts (start, n) repline-0.2.1.0/LICENSE0000644000000000000000000000204613401515732012504 0ustar0000000000000000Copyright (c) 2016-2019 Stephen Diehl Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. repline-0.2.1.0/Setup.hs0000644000000000000000000000005613341510266013132 0ustar0000000000000000import Distribution.Simple main = defaultMain repline-0.2.1.0/repline.cabal0000644000000000000000000000224313462313247014124 0ustar0000000000000000name: repline version: 0.2.1.0 synopsis: Haskeline wrapper for GHCi-like REPL interfaces. license: MIT license-file: LICENSE author: Stephen Diehl maintainer: stephen.m.diehl@gmail.com copyright: 2014-2019 Stephen Diehl category: User Interfaces build-type: Simple extra-source-files: README.md cabal-version: >=1.10 tested-with: GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.3, GHC == 7.10.1 homepage: https://github.com/sdiehl/repline bug-Reports: https://github.com/sdiehl/repline/issues description: Haskeline wrapper for GHCi-like REPL interfaces. Composable with normal mtl transformers. extra-source-files: README.md ChangeLog.md Source-Repository head Type: git Location: git@github.com:sdiehl/repline.git library hs-source-dirs: src exposed-modules: System.Console.Repline build-depends: base >= 4.6 && <5.0, containers >= 0.5 && <0.7, fail >= 4.9 && <4.10, mtl >= 2.2 && <2.3, process >= 1.2 && <2.0, haskeline >= 0.7 && <0.8 default-language: Haskell2010 repline-0.2.1.0/README.md0000644000000000000000000001056313401515756012767 0ustar0000000000000000Repline ------- [![Build Status](https://travis-ci.org/sdiehl/repline.svg)](https://travis-ci.org/sdiehl/repline) [![Hackage](https://img.shields.io/hackage/v/repline.svg)](https://hackage.haskell.org/package/repline) Slightly higher level wrapper for creating GHCi-like REPL monads that are composable with normal MTL transformers. Mostly exists because I got tired of implementing the same interface for simple shells over and over and decided to canonize the giant pile of hacks that I use to make Haskeline work. Usage ----- ```haskell type Repl a = HaskelineT IO a -- Evaluation : handle each line user inputs cmd :: String -> Repl () cmd input = liftIO $ print input -- Tab Completion: return a completion for partial words entered completer :: Monad m => WordCompleter m completer n = do let names = ["kirk", "spock", "mccoy"] return $ filter (isPrefixOf n) names -- Commands help :: [String] -> Repl () help args = liftIO $ print $ "Help: " ++ show args say :: [String] -> Repl () say args = do _ <- liftIO $ system $ "cowsay" ++ " " ++ (unwords args) return () options :: [(String, [String] -> Repl ())] options = [ ("help", help) -- :help , ("say", say) -- :say ] ini :: Repl () ini = liftIO $ putStrLn "Welcome!" repl :: IO () repl = evalRepl (pure ">>> ") cmd options Nothing (Word completer) ini ``` Trying it out: ```haskell $ runhaskell Simple.hs # Or if in a sandbox: cabal exec runhaskell Simple.hs Welcome! >>> kirk spock mccoy >>> k kirk >>> spam "spam" >>> :say Hello Haskell _______________ < Hello Haskell > --------------- \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || ``` Stateful Tab Completion ----------------------- Quite often tab completion is dependent on the internal state of the Repl so we'd like to query state of the interpreter for tab completions based on actions performed themselves within the Repl, this is modeleted naturally as a monad transformer stack with ``StateT`` on top of ``HaskelineT``. ```haskell type IState = Set.Set String type Repl a = HaskelineT (StateT IState IO) a -- Evaluation cmd :: String -> Repl () cmd input = modify $ \s -> Set.insert input s -- Completion comp :: (Monad m, MonadState IState m) => WordCompleter m comp n = do ns <- get return $ filter (isPrefixOf n) (Set.toList ns) -- Commands help :: [String] -> Repl () help args = liftIO $ print $ "Help!" ++ show args puts :: [String] -> Repl () puts args = modify $ \s -> Set.union s (Set.fromList args) opts :: [(String, [String] -> Repl ())] opts = [ ("help", help) -- :help , ("puts", puts) -- :puts ] ini :: Repl () ini = return () -- Tab completion inside of StateT repl :: IO () repl = flip evalStateT Set.empty $ evalRepl (pure ">>> ") cmd opts Nothing (Word comp) init ``` Prefix Completion ----------------- Just as GHCi will provide different tab completion for kind-level vs type-level symbols based on which prefix the user has entered, we can also set up a provide this as a first-level construct using a ``Prefix`` tab completer which takes care of the string matching behind the API. ```haskell type Repl a = HaskelineT IO a -- Evaluation cmd :: String -> Repl () cmd input = liftIO $ print input -- Prefix tab completeter defaultMatcher :: MonadIO m => [(String, CompletionFunc m)] defaultMatcher = [ (":file" , fileCompleter) , (":holiday" , listCompleter ["christmas", "thanksgiving", "festivus"]) ] -- Default tab completer byWord :: Monad m => WordCompleter m byWord n = do let names = ["picard", "riker", "data", ":file", ":holiday"] return $ filter (isPrefixOf n) names files :: [String] -> Repl () files args = liftIO $ do contents <- readFile (unwords args) putStrLn contents holidays :: [String] -> Repl () holidays [] = liftIO $ putStrLn "Enter a holiday." holidays xs = liftIO $ do putStrLn $ "Happy " ++ unwords xs ++ "!" opts :: [(String, [String] -> Repl ())] opts = [ ("file", files) , ("holiday", holidays) ] init :: Repl () init = return () repl :: IO () repl = evalRepl (pure ">>> ") cmd opts Nothing (Prefix (wordCompleter byWord) defaultMatcher) init ``` Trying it out: ```haskell $ runhaskell Main.hs >>> :file sample1.txt sample2.txt >>> :file sample1.txt >>> :holiday christmas thanksgiving festivus ``` License ------- Copyright (c) 2014-2019, Stephen Diehl Released under the MIT License repline-0.2.1.0/ChangeLog.md0000644000000000000000000000024513462313241013645 0ustar0000000000000000HEAD ==== 0.2.1.0 ======= - Add a `MonadFail` instance to `HaskelineT`. 0.2.0.0 ======= - `evalRepl` has changed signature. 0.1.0.0 ======= - Initial release.