byline 1.0.0.0 → 1.1.0.0

raw patch · 15 files changed

+443/−60 lines, 15 filesdep +attoparsecdep +optparse-applicativedep ~ansi-terminaldep ~haskelinesetup-changednew-component:exe:shellPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, optparse-applicative

Dependency ranges changed: ansi-terminal, haskeline

API changes (from Hackage documentation)

Files

• CHANGES.md +8/−0
• README.md +3/−14
• Setup.hs +4/−0
• byline.cabal +28/−13
• examples/shell.hs +85/−0
• examples/simple.hs +25/−20
• src/Byline.hs +0/−1
• src/Byline/Completion.hs +56/−0
• src/Byline/Exit.hs +2/−2
• src/Byline/Internal/Color.hs +5/−5
• src/Byline/Internal/Eval.hs +1/−1
• src/Byline/Internal/Prim.hs +0/−1
• src/Byline/Internal/Stylized.hs +3/−1
• src/Byline/Menu.hs +2/−2
• src/Byline/Shell.hs +221/−0

@@ -1,5 +1,13 @@ # Version History +## 1.1.0.0 (October 27, 2020)++  * New `Shell` module for building shell-like interfaces.++  * New completion helper function `completionFromList`.++  * Update dependencies to their latest versions+ ## 1.0.0.0 (July 27, 2020)  This version is the result of a major refactoring of the code in order

@@ -5,14 +5,14 @@ [![Hackage](https://img.shields.io/hackage/v/byline)](https://hackage.haskell.org/package/byline)  Byline simplifies writing interactive command-line applications by-building upon [ansi-terminal][] and [haskeline][]. This makes it+building upon [ansi-terminal][] and [haskeline][].  This makes it possible to print messages and prompts that include terminal escape sequences such as colors that are automatically disabled when standard-input is a file. It also means that Byline works on both+input is a file.  It also means that Byline works on both POSIX-compatible systems and on Windows.  The primary features of Byline include printing messages, prompting-for input, and generating custom menus. It was inspired by the+for input, and generating custom menus.  It was inspired by the [highline] Ruby library and the [terminal library][] by Craig Roche.  ## Example Using `MonadByline`@@ -33,14 +33,3 @@ ```  ![Demo](doc/demo.png)--## Interfaces--  * The MTL interface lives in the [`byline`](byline) directory.--  * A `fused-effects` interface is forthcoming.--[ansi-terminal]: http://hackage.haskell.org/package/ansi-terminal-[haskeline]: https://hackage.haskell.org/package/haskeline-[highline]: https://github.com/JEG2/highline-[terminal library]: https://github.com/cdxr/terminal

@@ -12,5 +12,9 @@ --   terms contained in the LICENSE file. -- -- License: BSD-2-Clause+module Main where+ import Distribution.Simple++main :: IO () main = defaultMain

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               byline-version:            1.0.0.0+version:            1.1.0.0 homepage:           https://github.com/pjones/byline bug-reports:        https://github.com/pjones/byline/issues license:            BSD-2-Clause@@ -11,7 +11,7 @@ category:           System, User Interfaces build-type:         Simple stability:          stable-tested-with:        GHC ==8.6.5 || ==8.8.3 || ==8.10.1+tested-with:        GHC ==8.6.5 || ==8.8.4 || ==8.10.2 synopsis:   Library for creating command-line interfaces (colors, menus, etc.) @@ -42,7 +42,7 @@   >   >   askLn question (Just "Haskell")   .-  <<https://github.com/pjones/byline/raw/master/doc/demo.png>>+  <<https://github.com/pjones/byline/raw/trunk/doc/demo.png>>  -------------------------------------------------------------------------------- extra-source-files:@@ -70,8 +70,10 @@     DeriveFunctor     DeriveTraversable     DerivingStrategies+    ExistentialQuantification     FlexibleContexts     FlexibleInstances+    FunctionalDependencies     GeneralizedNewtypeDeriving     InstanceSigs     KindSignatures@@ -82,6 +84,7 @@     RankNTypes     RecordWildCards     ScopedTypeVariables+    TupleSections     TypeFamilies    ghc-options:@@ -92,16 +95,18 @@ -------------------------------------------------------------------------------- common dependencies   build-depends:-    , ansi-terminal  >=0.6  && <0.11-    , base           >=4.9  && <5.0-    , colour         ^>=2.3-    , exceptions     >=0.8  && <0.11-    , free           ^>=5.1-    , haskeline      ^>=0.8-    , mtl            >=2.1  && <2.3-    , relude         >=0.6  && <0.8-    , terminfo-hs    >=0.1  && <0.3-    , text           >=0.11 && <1.3+    , ansi-terminal         >=0.6  && <0.12+    , attoparsec            ^>=0.13+    , base                  >=4.9  && <5.0+    , colour                ^>=2.3+    , exceptions            >=0.8  && <0.11+    , free                  ^>=5.1+    , haskeline             >=0.8  && <0.8.2+    , mtl                   >=2.1  && <2.3+    , optparse-applicative  >=0.16+    , relude                >=0.6  && <0.8+    , terminfo-hs           >=0.1  && <0.3+    , text                  >=0.11 && <1.3    mixins:     base hiding (Prelude),@@ -123,6 +128,7 @@     Byline.Internal.Stylized     Byline.Internal.Types     Byline.Menu+    Byline.Shell     Byline.Simulation  ------------------------------------------------------------------------------@@ -158,6 +164,15 @@ executable menu   import:        options, dependencies   main-is:       examples/menu.hs+  build-depends: byline++  if !flag(build-examples)+    buildable: False++--------------------------------------------------------------------------------+executable shell+  import:        options, dependencies+  main-is:       examples/shell.hs   build-depends: byline    if !flag(build-examples)

@@ -0,0 +1,85 @@+-- |+--+-- Copyright:+--   This file is part of the package byline. It is subject to the+--   license terms in the LICENSE file found in the top-level+--   directory of this distribution and at:+--+--     https://github.com/pjones/byline+--+--   No part of this package, including this file, may be copied,+--   modified, propagated, or distributed except according to the+--   terms contained in the LICENSE file.+--+-- License: BSD-2-Clause+module Main+  ( main,+  )+where++import Byline+import Byline.Shell+import qualified Data.Text as Text+import qualified Options.Applicative as O++data Command+  = Help+  | Echo [Text]+  | SetPrompt Text++parser :: O.Parser Command+parser =+  O.hsubparser $+    mconcat+      [ O.command "help" (O.info (pure Help) $ O.progDesc "This message"),+        O.command "echo" (O.info echoP $ O.progDesc "Print all arguments"),+        O.command "set-prompt" (O.info promptP $ O.progDesc "Change the prompt")+      ]+  where+    echoP =+      Echo+        <$> many+          ( O.strArgument $+              mconcat+                [ O.metavar "STR",+                  O.help "A string to print"+                ]+          )+    promptP =+      SetPrompt+        <$> O.strArgument+          ( mconcat+              [ O.metavar "STR",+                O.help "Set the prompt to STR"+              ]+          )++dispatch ::+  MonadByline m =>+  MonadState (Shell Command) m =>+  Command ->+  m ()+dispatch = \case+  Help -> do+    shell <- get+    shellHelp shell+  Echo ts ->+    sayLn (text $ Text.intercalate " " ts)+  SetPrompt prompt ->+    modify' (\s -> s {shellPrompt = text prompt})++main :: IO ()+main = do+  let shell =+        Shell+          { shellPrefs = O.defaultPrefs,+            shellInfo = O.info parser (O.progDesc "Simple shell"),+            shellPrompt = "byline> "+          }+  void $ runBylineT (go shell)+  where+    go :: MonadByline m => Shell Command -> m ()+    go shell = do+      sayLn (text "Starting shell, use ^D to exit")+      pushCompletionFunction (shellCompletion shell)+      (`evalStateT` shell) $ forever (get >>= runShell dispatch)

@@ -22,29 +22,34 @@ import qualified Data.Text as Text  main :: IO ()-main = void $ runBylineT $ do-  -- Start with a simple message to standard output:-  sayLn ("I can use " <> ("color" <> fg blue) <> "!")+main = void $+  runBylineT $ do+    -- Start with a simple message to standard output:+    sayLn ("I can use " <> ("color" <> fg blue) <> "!") -  -- Get user input with a stylized prompt:-  let question =-        "What's your favorite "-          <> ("language" <> bold <> fg green)-          <> "? "-  language <- askLn question Nothing+    -- When not using any stylized modifiers you can use the `text'+    -- helper function to avoid "Ambiguous type variable":+    sayLn (text "This is some plain text") -  if Text.null language-    then Exit.die ("Cat got your tongue?" <> fg magenta)-    else sayLn ("I see, you like " <> (text language <> fg red) <> ".")+    -- Get user input with a stylized prompt:+    let question =+          "What's your favorite "+            <> ("language" <> bold <> fg green)+            <> "? "+    language <- askLn question Nothing -  -- Keep prompting until a confirmation function indicates that the-  -- user's input is sufficient:-  let question =-        "What's your "-          <> ("name" <> fg green <> underline)-          <> "? "-  name <- askUntil question Nothing (pure . atLeastThreeChars)-  sayLn $ "Hey there " <> text name <> fg (rgb 108 113 196)+    if Text.null language+      then Exit.die ("Cat got your tongue?" <> fg magenta)+      else sayLn ("I see, you like " <> (text language <> fg red) <> ".")++    -- Keep prompting until a confirmation function indicates that the+    -- user's input is sufficient:+    let question =+          "What's your "+            <> ("name" <> fg green <> underline)+            <> "? "+    name <- askUntil question Nothing (pure . atLeastThreeChars)+    sayLn $ "Hey there " <> text name <> fg (rgb 108 113 196)  -- | Example confirmation function that requires the input to be three -- or more characters long.

@@ -57,7 +57,6 @@ import Byline.Internal.Eval (BylineT, MonadByline (..), runBylineT) import qualified Byline.Internal.Prim as Prim import Byline.Internal.Stylized-import Prelude hiding (ask)  -- | Output the given stylized text. --

@@ -20,6 +20,10 @@     CompletionFunc,     Completion (..), +    -- * Completion Helpers+    CompLoc (..),+    completionFromList,+     -- * Setting the Active Completion Function     pushCompletionFunction,     popCompletionFunction,@@ -29,6 +33,8 @@ import Byline.Internal.Completion import Byline.Internal.Eval (MonadByline (..)) import qualified Byline.Internal.Prim as Prim+import Data.Char (isSpace)+import qualified Data.Text as Text  -- | Add a 'CompletionFunc' to the stack. --@@ -41,6 +47,56 @@ -- @since 1.0.0.0 popCompletionFunction :: MonadByline m => m () popCompletionFunction = liftByline Prim.popCompFunc++-- | Type to describe where completions are allowed.+--+-- @since 1.1.0.0+data CompLoc+  = -- | Only complete the first word of input.+    CompHead+  | -- | Complete any word except the first.+    CompTail+  | -- | Perform completion anywhere in the input.+    CompAny++-- | Generate a completion function that uses the given list as the+-- completion candidates.+--+-- @since 1.1.0.0+completionFromList ::+  forall m.+  Applicative m =>+  -- | Where to allow completion.+  CompLoc ->+  -- | List of completion candidates.+  [Text] ->+  -- | The generated completion function.+  CompletionFunc m+completionFromList loc ts (left, right) =+  case loc of+    CompHead ->+      if Text.null left || Text.all (isSpace >>> not) left+        then go (left, right)+        else pure (mempty, mempty)+    CompTail ->+      if Text.any isSpace left+        then completeLastWord (left, right)+        else pure (mempty, mempty)+    CompAny ->+      completeLastWord (left, right)+  where+    go :: CompletionFunc m+    go (left, _) =+      if Text.null left+        then pure ("", completions ts)+        else pure ("", completions (filter (Text.isPrefixOf left) ts))+    completeLastWord :: CompletionFunc m+    completeLastWord (left, right) =+      let word = Text.takeWhileEnd (isSpace >>> not) left+          prefix = Text.dropEnd (Text.length word) left+       in go (word, right) <&> first (const prefix)+    completions :: [Text] -> [Completion]+    completions = map (\t -> Completion t t True)  -- $use --

@@ -56,9 +56,9 @@   let msg =         mconcat           [ text name,-            ": ",+            text ": ",             toStylizedText a,-            "\n"+            text "\n"           ]    mode <- defaultRenderMode stderr

@@ -158,8 +158,8 @@ term256Locations = zipWith (\c i -> (i, C.cieXYZView c)) colors [16 ..]   where     colors :: [C.Colour Double]-    colors = do-      r <- [0.0, 0.2 .. 1.0]-      g <- [0.0, 0.2 .. 1.0]-      b <- [0.0, 0.2 .. 1.0]-      return (C.sRGB r g b)+    colors =+      C.sRGB+        <$> [0.0, 0.2 .. 1.0]+        <*> [0.0, 0.2 .. 1.0]+        <*> [0.0, 0.2 .. 1.0]

@@ -202,7 +202,7 @@       AskLn s d k -> do         let prompt =               renderText renderMode $-                maybe s (\d' -> s <> text "[" <> text d' <> "] ") d+                maybe s (\d' -> s <> text "[" <> text d' <> text "] ") d         liftHaskeline (Haskeline.getInputLine (toString prompt)) >>= \case           Nothing -> EvalT empty           Just answer

@@ -30,7 +30,6 @@ import Byline.Internal.Stylized (Stylized, text) import Control.Monad.Trans.Free.Church (MonadFree) import qualified Control.Monad.Trans.Free.Church as Free-import Prelude hiding (ask)  -- | Primitive operations as a free monad. --

@@ -82,7 +82,9 @@  -- | Helper function to create stylized text.  If you enable the -- @OverloadedStrings@ extension then you can create stylized text--- directly without using this function.+-- directly without using this function.  However, if you are not+-- using any of the other stylized modifiers then this function can be+-- helpful for avoiding "Ambiguous type variable" compile errors. -- -- This function is also helpful for producing stylized text from an -- existing @Text@ value.

@@ -223,9 +223,9 @@     firstItem = Text.strip (renderText Plain (_menuItemPrefix m 1))     -- Print the entire menu.     displayMenu = do-      maybe pass ((<> "\n") >>> sayLn) (_menuBanner m)+      maybe pass ((<> text "\n") >>> sayLn) (_menuBanner m)       cache <- foldlM listItem mempty (zip [1 ..] (toList $ _menuItems m))-      sayLn (maybe mempty ("\n" <>) (_menuBeforePrompt m))+      sayLn (maybe mempty (text "\n" <>) (_menuBeforePrompt m))       pure cache     -- Print a menu item and cache its prefix in a Map.     listItem cache (index, item) = do

@@ -0,0 +1,221 @@+-- |+--+-- Copyright:+--   This file is part of the package byline. It is subject to the+--   license terms in the LICENSE file found in the top-level+--   directory of this distribution and at:+--+--     https://github.com/pjones/byline+--+--   No part of this package, including this file, may be copied,+--   modified, propagated, or distributed except according to the+--   terms contained in the LICENSE file.+--+-- License: BSD-2-Clause+--+-- Interactive shells.+module Byline.Shell+  ( -- * Shell-like Interfaces+    Shell (..),+    runShell,+    shellHelp,+    shellCompletion,++    -- * Re-exports+    module Byline.Completion,+  )+where++import Byline+import Byline.Completion+import qualified Data.Attoparsec.Text as Atto+import Data.Char+import qualified Data.Text as Text+import qualified Options.Applicative as O+import qualified Options.Applicative.Common as O+import qualified Options.Applicative.Types as O+import Relude.Extra.Map++-- | A type that describes how to process user-entered shells.+--+-- @since 1.1.0.0+data Shell a = Shell+  { -- | Optparse-applicative parser preferences.  If you don't have+    -- any specific needs you can use 'O.defaultPrefs' to get the+    -- default parser preferences.+    shellPrefs :: O.ParserPrefs,+    -- | The shell parser wrapped in a 'O.ParserInfo'.  This is+    -- generally created with the 'O.info' function.+    shellInfo :: O.ParserInfo a,+    -- | The prompt to display.+    shellPrompt :: Stylized Text+  }++-- | Run a single iteration of the shell.+--+-- @since 1.1.0.0+runShell ::+  MonadByline m =>+  (a -> m ()) ->+  Shell a ->+  m ()+runShell dispatch Shell {..} = do+  input <- askLn shellPrompt Nothing+  words <- shellSplit input+  unless (null words) (go (map toString words))+  where+    go words = do+      case O.execParserPure shellPrefs shellInfo words of+        O.Success a ->+          dispatch a+        O.Failure help -> do+          let str = fst (O.renderFailure help "")+          sayLn (text $ toText str)+        O.CompletionInvoked _ ->+          pure ()++-- | Print a list of shell commands.+--+-- @since 1.1.0.0+shellHelp ::+  MonadByline m =>+  Shell a ->+  m ()+shellHelp Shell {..} = do+  let h = O.parserFailure shellPrefs shellInfo (O.ShowHelpText Nothing) mempty+      s = fst (O.renderFailure h "")+  sayLn (text $ toText s)++-- | A completion function for shell commands.+--+-- Adds completion for subcommand names and their flags.+--+-- @since 1.1.0.0+shellCompletion :: Applicative m => Shell a -> CompletionFunc m+shellCompletion shell input@(left, _) = do+  if Text.null left || Text.all (isSpace >>> not) left+    then completionFromList CompHead (keys commands) input+    else completionFromList CompTail flags input+  where+    -- Get a list of flags for the current subcommand.+    flags :: [Text]+    flags = fromMaybe [] $ do+      cmd <- Text.words left & viaNonEmpty head+      names <- lookup cmd commands+      pure $+        flip map names $ \case+          O.OptShort c -> toText ['-', c]+          O.OptLong s -> "--" <> toText s++    -- A map of command names and their flags.+    commands :: HashMap Text [O.OptName]+    commands =+      fromList $+        concat $+          O.mapParser+            (const nameAndFlags)+            (O.infoParser $ shellInfo shell)+      where+        nameAndFlags opt =+          case O.optMain opt of+            O.CmdReader _ cmds p -> (`map` cmds) $ \cmd ->+              ( toText cmd,+                maybe+                  []+                  ( O.infoParser+                      >>> O.mapParser (const optnames)+                      >>> concat+                  )+                  (p cmd)+              )+            _ -> mempty+        optnames opt =+          case O.optMain opt of+            O.OptReader ns _ _ -> ns+            O.FlagReader ns _ -> ns+            _ -> mempty++-- | Internal function to split user input into words similar to what+-- a POSIX shell does.+shellSplit :: MonadByline m => Text -> m [Text]+shellSplit t =+  let input = Text.strip t+   in if Text.null input+        then pure []+        else case Atto.parseOnly go input of+          Left e -> do+            sayLn (("invalid input" <> fg red) <> ": " <> text (toText e))+            pure []+          Right ws ->+            pure ws+  where+    go :: Atto.Parser [Text]+    go = Atto.many1 (bare <|> quoted) <* expectEndOfInput++    expectEndOfInput :: Atto.Parser ()+    expectEndOfInput = (Atto.endOfInput <|>) $ do+      leftover <- Atto.many1 Atto.anyChar+      fail ("unexpected input: " <> leftover)++    -- A bare word (not wrapped in quotes).+    bare :: Atto.Parser Text+    bare = (Atto.<?> "unquoted word") $ do+      word <- Atto.many1 bareChar+      void (Atto.many1 Atto.space) <|> Atto.endOfInput+      pure (toText word)++    -- A run of characters that may have quoted characters.+    --+    -- Just like with the POSIX shell, the quotes don't have to be on+    -- the outsides of the final string.+    quoted :: Atto.Parser Text+    quoted = do+      prefix <- many bareChar+      quote <- Atto.satisfy (\c -> c == '\'' || c == '"') Atto.<?> "quote"+      (_, ScanState {..}) <-+        Atto.runScanner (ScanState [] False) (quoteScanner quote)+      when scanEscape (fail "expecting a character after a backslash")+      _ <- Atto.char quote Atto.<?> "closing quotation character"+      let str = toText prefix <> toText (reverse scanResult)+      end <-+        (Atto.many1 Atto.space $> True)+          <|> (Atto.endOfInput $> True)+          <|> pure False+      if end then pure str else (str <>) <$> quoted++    -- Parse a single character that might be escaped.+    bareChar :: Atto.Parser Char+    bareChar = do+      char <-+        Atto.satisfy+          ( \c ->+              not (isSpace c)+                && c /= '\''+                && c /= '"'+                && isPrint c+          )+      if char == '\\'+        then Atto.anyChar Atto.<?> "escaped character"+        else pure char++-- | State needed to scan input looking for a closing quote.+data ScanState = ScanState+  { scanResult :: [Char],+    scanEscape :: Bool+  }++-- | A scanning function that looks for a terminating quote.+quoteScanner ::+  -- | The quote character we are searching for.+  Char ->+  -- | The output of the last invocation.+  ScanState ->+  -- | The current input character.+  Char ->+  -- | 'Just' to continue, 'Nothing' to stop.+  Maybe ScanState+quoteScanner quote ScanState {..} input+  | scanEscape = Just (ScanState (input : scanResult) False)+  | input == '\\' = Just (ScanState scanResult True)+  | input == quote = Nothing+  | otherwise = Just (ScanState (input : scanResult) False)