climb (empty) → 0.3.1

raw patch · 6 files changed

+252/−0 lines, 6 filesdep +basedep +bytestringdep +climbsetup-changed

Dependencies added: base, bytestring, climb, containers, exceptions, linenoise, mtl, text, unliftio-core

Files

LICENSE +30/−0
README.md +5/−0
Setup.hs +2/−0
app/Main.hs +43/−0
climb.cabal +65/−0
src/Climb.hs +107/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Eric Conlon (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Eric Conlon nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,5 @@+# climb++[![CircleCI](https://circleci.com/gh/ejconlon/climb/tree/master.svg?style=svg)](https://circleci.com/gh/ejconlon/climb/tree/master)++Building blocks for a GHCI-like REPL with colon-commands. (Not production ready!) See the [demo app](https://github.com/ejconlon/climb/blob/master/app/Main.hs) for usage, or see the lower-level [haskell-linenoise](https://github.com/ejconlon/haskell-linenoise) library this depends on.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,43 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad.Catch (MonadThrow)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..))+import Climb+import Linenoise++newtype Repl a = Repl { unRepl :: ReplT () () IO a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow)++instance MonadUnliftIO Repl where+  askUnliftIO = do+    UnliftIO run <- Repl askUnliftIO+    pure (UnliftIO (run . unRepl))++runRepl :: Repl a -> IO a+runRepl r = fmap fst (runReplT (unRepl r) () ())++options :: OptionCommands Repl+options = mempty++exec :: Command Repl+exec = const (pure ReplContinue)++completion :: Completion Repl+completion = const (pure [])++replDef :: ReplDef Repl+replDef = ReplDef+  { _rdOnInterrupt = ReplContinue+  , _rdGreeting = "Hello, REPL!"+  , _rdPrompt = "> "+  , _rdOptionCommands = options+  , _rdExecCommand = exec+  , _rdCompletion = completion+  }++main :: IO ()+main = runRepl (runReplDef replDef)

+ climb.cabal view

@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: f959e3804f6a76af277dfee45863cf2b2521ec7733ce877dac7398aa36e9438b++name:           climb+version:        0.3.1+synopsis:       Building blocks for a GHCi-like REPL with colon-commands+description:    Please see the README on GitHub at <https://github.com/ejconlon/climb#readme>+category:       User Interfaces+homepage:       https://github.com/ejconlon/climb#readme+bug-reports:    https://github.com/ejconlon/climb/issues+author:         Eric Conlon+maintainer:     ejconlon@gmail.com+copyright:      (c) 2019 Eric Conlon+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/ejconlon/climb++library+  exposed-modules:+      Climb+  other-modules:+      Paths_climb+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds+  build-depends:+      base >=4.12 && <5+    , bytestring >=0.10+    , containers >=0.6+    , exceptions >=0.10+    , linenoise >=0.3.1+    , mtl >=2.2+    , text >=1.2+    , unliftio-core >=0.1+  default-language: Haskell2010++executable climb-demo+  main-is: Main.hs+  other-modules:+      Paths_climb+  hs-source-dirs:+      app+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , bytestring >=0.10+    , climb+    , containers >=0.6+    , exceptions >=0.10+    , linenoise >=0.3.1+    , mtl >=2.2+    , text >=1.2+    , unliftio-core >=0.1+  default-language: Haskell2010

+ src/Climb.hs view

@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Building blocks for a GHCI-like REPL with colon-commands.+module Climb+  ( Command+  , CommandExc (..)+  , Completion+  , OptionCommands+  , ReplDef (..)+  , ReplDirective (..)+  , bareCommand+  , noOptionCommands+  , noCompletion+  , runReplDef+  ) where++import Control.Exception (Exception)+import Control.Monad (unless)+import Control.Monad.Catch (MonadThrow (..))+import Control.Monad.Fix (fix)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Unlift (MonadUnliftIO)+import Data.Foldable (for_)+import Data.Typeable (Typeable)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as TIO+import Linenoise.Repl (ReplDirective (..), replM)++-- | A 'Command' takes some input, performs some effect, and returns a directive (continue or quit).+type Command m = Text -> m ReplDirective++-- | List of 'Command's by name with help text.+type OptionCommands m = Map Text (Text, Command m)++-- | A 'Completion' takes some input and returns potential matches.+type Completion m = Text -> m [Text]++-- | Sometimes things go wrong...+data CommandExc+  = ExpectedNoInputError+  -- ^ An option 'Command' got input when it expected None+  | MissingCommandError !Text+  -- ^ An option 'Command' was not found by name.+  deriving (Eq, Show, Typeable)++instance Exception CommandExc++-- | Defines a REPL with commands, options, and completion.+data ReplDef m =+  ReplDef+    { _rdOnInterrupt :: !ReplDirective+    , _rdGreeting :: !Text+    , _rdPrompt :: !Text+    , _rdOptionCommands :: !(OptionCommands m)+    , _rdExecCommand :: !(Command m)+    , _rdCompletion :: !(Completion m)+    }++noOptionCommands :: OptionCommands m+noOptionCommands = Map.empty++noCompletion :: Applicative m => Completion m+noCompletion = const (pure [])++assertEmpty :: MonadThrow m => Text -> m ()+assertEmpty input = unless (Text.null input) (throwM ExpectedNoInputError)++-- | Helps you define commands that expect no input.+bareCommand :: MonadThrow m => m ReplDirective -> Command m+bareCommand act input = assertEmpty input >> act++quitCommand :: MonadThrow m => Command m+quitCommand = bareCommand (pure ReplQuit)++helpCommand :: (MonadThrow m, MonadIO m) => OptionCommands m -> Command m+helpCommand opts = bareCommand $ do+  liftIO (TIO.putStrLn "Available commands:")+  for_ (Map.toList opts) $ \(name, (desc, _)) -> liftIO (TIO.putStrLn (":" <> name <> "\t" <> desc))+  pure ReplContinue++defaultOptions :: (MonadThrow m, MonadIO m) => OptionCommands m -> OptionCommands m+defaultOptions opts = Map.fromList+    [ ("quit", ("quit", quitCommand))+    , ("help", ("describe all commands", helpCommand opts))+    ]++outerCommand :: MonadThrow m => OptionCommands m -> Command m -> Command m+outerCommand opts exec = \input ->+  case Text.uncons input of+    Just (':', rest) -> do+      let (name, subInput) = Text.break (==' ') rest+      case Map.lookup name opts of+        Nothing -> throwM (MissingCommandError name)+        Just (_, command) -> command (Text.drop 1 subInput)+    _ -> exec input++-- | Runs a REPL as defined.+runReplDef :: (MonadThrow m, MonadUnliftIO m) => ReplDef m -> m ()+runReplDef (ReplDef onInterrupt greeting prompt opts exec comp) = do+  let allOpts = fix (\c -> defaultOptions c <> opts)+      action = outerCommand allOpts exec+  liftIO (TIO.putStrLn greeting)+  liftIO (TIO.putStrLn "Enter `:quit` to exit or `:help` to see all commands.")+  replM onInterrupt prompt action comp