byline 0.4.0.0 → 1.0.0.0

raw patch · 32 files changed

+2142/−1501 lines, 32 filesdep +freedep +reludedep +tastydep −containersdep −transformersdep ~ansi-terminaldep ~colourdep ~haskelinesetup-changednew-component:exe:demoPVP ok

version bump matches the API change (PVP)

Dependencies added: free, relude, tasty, tasty-hunit

Dependencies removed: containers, transformers

Dependency ranges changed: ansi-terminal, colour, haskeline

API changes (from Hackage documentation)

Files

• CHANGES.md +37/−0
• README.md +28/−3
• Setup.hs +14/−0
• byline.cabal +118/−59
• examples/demo.hs +38/−0
• examples/menu.hs +53/−37
• examples/simple.hs +38/−37
• src/Byline.hs +201/−0
• src/Byline/Completion.hs +49/−0
• src/Byline/Exit.hs +65/−0
• src/Byline/Internal/Color.hs +165/−0
• src/Byline/Internal/Completion.hs +118/−0
• src/Byline/Internal/Eval.hs +254/−0
• src/Byline/Internal/Prim.hs +87/−0
• src/Byline/Internal/Simulation.hs +164/−0
• src/Byline/Internal/Stylized.hs +248/−0
• src/Byline/Internal/Types.hs +91/−0
• src/Byline/Menu.hs +273/−0
• src/Byline/Simulation.hs +41/−0
• src/System/Console/Byline.hs +0/−119
• src/System/Console/Byline/Color.hs +0/−69
• src/System/Console/Byline/Completion.hs +0/−57
• src/System/Console/Byline/Internal/Byline.hs +0/−153
• src/System/Console/Byline/Internal/Color.hs +0/−101
• src/System/Console/Byline/Internal/Completion.hs +0/−55
• src/System/Console/Byline/Internal/Render.hs +0/−155
• src/System/Console/Byline/Internal/Types.hs +0/−78
• src/System/Console/Byline/Menu.hs +0/−249
• src/System/Console/Byline/Modifiers.hs +0/−66
• src/System/Console/Byline/Primitive.hs +0/−172
• src/System/Console/Byline/Stylized.hs +0/−91
• test/Main.hs +60/−0

@@ -1,5 +1,42 @@ # Version History +## 1.0.0.0 (July 27, 2020)++This version is the result of a major refactoring of the code in order+to produce an MTL-compatible library.++  - New MTL-style class: `MonadByline`++  - Proper monad transformer: `BylineT`++  - Most of the library is under a single import: `Byline`++  - Added a `ToStylizedText` class to enable using custom types with+    functions like `menu`.++  - New `Byline.Exit.die` function to exit the current process with a+    stylized error message.  Thanks to the `ToStylizedText` class it's+    easy to exit with custom error types.++  - The `Report` type and associated functions were superfluous and+    therefore removed.  (Consider using the new `die` and `warn`+    functions in `Byline.Exit`.)++  - Menus now use `NonEmpty` to represent items and therefore the menu+    `Choice` type has been simplified, removing the `NoItems`+    constructor.++  - Fixed a bug where `Stylized Text` was not rendered when using one+    of the `ask*` functions (#1).++  - Proper encoding of escape sequences so Haskeline doesn't+    [print garbage](https://github.com/judah/haskeline/issues/130) on Windows.++  - Added support for RGB terminals++  - Added an implementation of 'MonadByline' that uses simulated user+    input to test your Byline code.+ ## 0.4.0.0 (March 17, 2020)    - The `askUntil` function is now polymorphic in its return type.

@@ -1,6 +1,10 @@ # Byline -Byline simplifies writing interactive terminal applications by+[![CI](https://github.com/pjones/byline/workflows/CI/badge.svg)](https://github.com/pjones/byline/actions)+[![GitHub tag (latest by date)](https://img.shields.io/github/v/tag/pjones/byline?label=release)](https://github.com/pjones/byline/releases)+[![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 possible to print messages and prompts that include terminal escape sequences such as colors that are automatically disabled when standard@@ -11,9 +15,30 @@ for input, and generating custom menus. It was inspired by the [highline] Ruby library and the [terminal library][] by Craig Roche. -## Examples+## Example Using `MonadByline` -Please see the example programs in the `examples` directory.+```haskell+example :: MonadByline m => m Text+example = do+  sayLn ("Hey, I like " <> ("Haskell" <> fg magenta) <> "!")++  let question =+        "What's "+          <> ("your" <> bold)+          <> " favorite "+          <> ("language" <> fg green <> underline)+          <> "? "++  askLn question (Just "Haskell")+```++![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

@@ -1,2 +1,16 @@+-- |+--+-- 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 import Distribution.Simple main = defaultMain

@@ -1,30 +1,48 @@-cabal-version: 2.2+cabal-version:      2.2+name:               byline+version:            1.0.0.0+homepage:           https://github.com/pjones/byline+bug-reports:        https://github.com/pjones/byline/issues+license:            BSD-2-Clause+license-file:       LICENSE+author:             Peter Jones <pjones@devalot.com>+maintainer:         Peter Jones <pjones@devalot.com>+copyright:          Copyright: (c) 2015-2020 Peter J. Jones+category:           System, User Interfaces+build-type:         Simple+stability:          stable+tested-with:        GHC ==8.6.5 || ==8.8.3 || ==8.10.1+synopsis:+  Library for creating command-line interfaces (colors, menus, etc.) ----------------------------------------------------------------------------------name:          byline-version:       0.4.0.0-synopsis:      Library for creating command-line interfaces (colors, menus, etc.)-homepage:      https://github.com/pjones/byline-bug-reports:   https://github.com/pjones/byline/issues-license:       BSD-2-Clause-license-file:  LICENSE-author:        Peter Jones <pjones@devalot.com>-maintainer:    Peter Jones <pjones@devalot.com>-copyright:     Copyright: (c) 2015-2020 Peter J. Jones-category:      System, User Interfaces-build-type:    Simple-stability:     stable description:-  Byline simplifies writing interactive terminal applications by+  Byline simplifies writing interactive command-line applications by   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-  POSIX-compatible systems and on Windows.+  sequences (such as setting text colors) that are automatically+  disabled when standard 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   @highline@ Ruby library and the @terminal@ library by Craig Roche.+  .+  == Example+  .+  > example :: MonadByline m => m Text+  > example = do+  >   sayLn ("Hey, I like " <> ("Haskell" <> fg magenta) <> "!")+  >+  >   let question =+  >         "What's "+  >           <> ("your" <> bold)+  >           <> " favorite "+  >           <> ("language" <> fg green <> underline)+  >           <> "? "+  >+  >   askLn question (Just "Haskell")+  .+  <<https://github.com/pjones/byline/raw/master/doc/demo.png>>  -------------------------------------------------------------------------------- extra-source-files:@@ -34,62 +52,103 @@  -------------------------------------------------------------------------------- source-repository head-  type: git+  type:     git   location: https://github.com/pjones/byline.git  -------------------------------------------------------------------------------- flag build-examples   description: Build examples when building the library.-  manual: True-  default: False+  manual:      True+  default:     False  -------------------------------------------------------------------------------- common options-  default-language: Haskell2010-  ghc-options: -Wall-               -Werror=incomplete-record-updates-               -Werror=incomplete-uni-patterns-               -Werror=missing-home-modules-               -Widentities-               -Wmissing-export-lists-               -Wredundant-constraints+  default-language:   Haskell2010+  default-extensions:+    DefaultSignatures+    DeriveFoldable+    DeriveFunctor+    DeriveTraversable+    DerivingStrategies+    FlexibleContexts+    FlexibleInstances+    GeneralizedNewtypeDeriving+    InstanceSigs+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    NamedFieldPuns+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TypeFamilies +  ghc-options:+    -Wall -Wno-name-shadowing -Werror=incomplete-record-updates+    -Werror=incomplete-uni-patterns -Werror=missing-home-modules+    -Widentities -Wmissing-export-lists -Wredundant-constraints+ -------------------------------------------------------------------------------- common dependencies-  build-depends: base          >= 4.9  && < 5.0-               , ansi-terminal >= 0.6  && < 0.12-               , colour        >= 2.3  && < 2.4-               , containers    >= 0.5  && < 0.7-               , exceptions    >= 0.8  && < 0.11-               , haskeline     >= 0.7  && < 0.8-               , mtl           >= 2.1  && < 2.3-               , terminfo-hs   >= 0.1  && < 0.3-               , text          >= 0.11 && < 1.3-               , transformers  >= 0.3  && < 0.6+  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 +  mixins:+    base hiding (Prelude),+    relude (Relude as Prelude, Relude.Extra.Map)+ -------------------------------------------------------------------------------- library-  import: options, dependencies-  hs-source-dirs: src-+  import:          options, dependencies+  hs-source-dirs:  src   exposed-modules:-    System.Console.Byline-    System.Console.Byline.Color-    System.Console.Byline.Completion-    System.Console.Byline.Internal.Byline-    System.Console.Byline.Internal.Color-    System.Console.Byline.Internal.Completion-    System.Console.Byline.Internal.Render-    System.Console.Byline.Internal.Types-    System.Console.Byline.Menu-    System.Console.Byline.Modifiers-    System.Console.Byline.Primitive-    System.Console.Byline.Stylized+    Byline+    Byline.Completion+    Byline.Exit+    Byline.Internal.Color+    Byline.Internal.Completion+    Byline.Internal.Eval+    Byline.Internal.Prim+    Byline.Internal.Simulation+    Byline.Internal.Stylized+    Byline.Internal.Types+    Byline.Menu+    Byline.Simulation +------------------------------------------------------------------------------+test-suite test+  import:         options, dependencies+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Main.hs+  build-depends:+    , byline+    , tasty        >=1.2+    , tasty-hunit  ^>=0.10+ --------------------------------------------------------------------------------+executable demo+  import:        options, dependencies+  main-is:       examples/demo.hs+  build-depends: byline++  if !flag(build-examples)+    buildable: False++-------------------------------------------------------------------------------- executable simple-  import: options, dependencies-  main-is: examples/simple.hs+  import:        options, dependencies+  main-is:       examples/simple.hs   build-depends: byline    if !flag(build-examples)@@ -97,8 +156,8 @@  -------------------------------------------------------------------------------- executable menu-  import: options, dependencies-  main-is: examples/menu.hs+  import:        options, dependencies+  main-is:       examples/menu.hs   build-depends: byline    if !flag(build-examples)

@@ -0,0 +1,38 @@+-- |+--+-- 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++-- | Simple example.+example :: MonadByline m => m Text+example = do+  sayLn ("Hey, I like " <> ("Haskell" <> fg magenta) <> "!")++  let question =+        "What's "+          <> ("your" <> bold)+          <> " favorite "+          <> ("language" <> fg green <> underline)+          <> "? "++  askLn question (Just "Haskell")++-- | Main.+main :: IO ()+main = runBylineT example >>= print

@@ -1,45 +1,61 @@-{-# LANGUAGE OverloadedStrings #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-----------------------------------------------------------------------------------module Main (main) where+-- |+--+-- 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 Data.Text (Text)-import System.Console.Byline+import Byline.Menu+import qualified Data.List.NonEmpty as NonEmpty ----------------------------------------------------------------------------------data Item = Fruit Text | Vegetable Text deriving Show+-- | Menu items that we'll ask the user to choose from.+data Item+  = Fruit Text+  | Vegetable Text+  deriving (Show) ----------------------------------------------------------------------------------displayItem :: Item -> Stylized-displayItem (Fruit     name) = text name <> (" (fruit)"     <> fg red)-displayItem (Vegetable name) = text name <> (" (vegetable)" <> fg green)+-- | How to display a menu item.+instance ToStylizedText Item where+  toStylizedText item = case item of+    Fruit name -> text name <> (" (fruit)" <> fg red)+    Vegetable name -> text name <> (" (vegetable)" <> fg green) ----------------------------------------------------------------------------------items :: [Item]-items = [ Fruit     "Watermelon"-        , Vegetable "Cucumber"-        , Fruit     "Kiwi"-        , Vegetable "Asparagus"-        ]+-- | The list of menu items.+items :: NonEmpty Item+items =+  NonEmpty.fromList+    [ Fruit "Watermelon",+      Vegetable "Cucumber",+      Fruit "Kiwi",+      Vegetable "Asparagus"+    ] ---------------------------------------------------------------------------------+-- | It's main! main :: IO () main = do-  let menuConfig = banner "Pick a snack: " $ menu items displayItem-      prompt     = "Which snack? "-      onError    = "please pick a valid item!" <> fg red+  let menuConfig =+        menuBanner ("Pick a snack: " <> bold) $+          menu items+      prompt = "Which snack? " <> bold <> fg yellow+      onError = "Please pick a valid item!" <> fg red -  answer <- runByline $ askWithMenuRepeatedly menuConfig prompt onError-  putStrLn ("you picked: " ++ show answer)+  -- Display the menu and get back the item the user selected.  The+  -- user will be able to select an item using it's index, name, or+  -- using tab completion.+  answer <-+    runBylineT $+      askWithMenuRepeatedly menuConfig prompt onError++  putStrLn ("You picked: " ++ show answer)

@@ -1,53 +1,54 @@-{-# LANGUAGE OverloadedStrings #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-----------------------------------------------------------------------------------module Main (main) where+-- |+--+-- 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 Control.Monad (void)-import Data.Text (Text)+import Byline+import qualified Byline.Exit as Exit import qualified Data.Text as Text-import System.Console.Byline --------------------------------------------------------------------------------- main :: IO ()-main = void $ runByline $ do--  -- Simple message to stdout:-  sayLn "Okay, let's kick this off"--  -- Now with some color:-  sayLn ("I can use " <> ("color" <> fg blue) <> " too!")+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) <> "? "-  language <- ask question Nothing+  let question =+        "What's your favorite "+          <> ("language" <> bold <> fg green)+          <> "? "+  language <- askLn question Nothing    if Text.null language-    then sayLn "Cat got your tongue?"+    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:-  name <- askUntil "What's your name? " Nothing atLeastThreeChars+  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.-atLeastThreeChars :: Text -> IO (Either Stylized Text)-atLeastThreeChars input = return $-  if Text.length input < 3-    then Left "You can do better."-    else Right input+atLeastThreeChars :: Text -> Either (Stylized Text) Text+atLeastThreeChars input+  | Text.length input < 3 = Left ("You can do better." <> bg red)+  | otherwise = Right input

@@ -0,0 +1,201 @@+-- |+--+-- Copyright:+--   This file is part of the package addy. 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 Byline+  ( -- * How to Use this Library+    -- $use++    -- * Byline Class and Transformer+    MonadByline,+    BylineT,+    runBylineT,++    -- * Basic User Interaction+    say,+    sayLn,+    askLn,+    askChar,+    askPassword,+    askUntil,++    -- * Stylizing Modifiers+    Stylized,+    ToStylizedText (..),+    text,+    fg,+    bg,+    bold,+    underline,+    swapFgBg,++    -- * Colors+    Color,+    black,+    red,+    green,+    yellow,+    blue,+    magenta,+    cyan,+    white,+    rgb,+  )+where++import Byline.Internal.Color+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.+--+-- See also: 'sayLn'.+--+-- @since 1.0.0.0+say ::+  (MonadByline m, ToStylizedText a) =>+  -- | The stylized text to output.+  a ->+  m ()+say =+  toStylizedText+    >>> Prim.say+    >>> liftByline++-- | Like 'say', but append a newline character.+--+-- @since 1.0.0.0+sayLn ::+  (MonadByline m, ToStylizedText a) =>+  -- | The stylized text to output.  An appropirate line ending+  -- character will be added to the end of this text.+  a ->+  m ()+sayLn =+  toStylizedText+    >>> Prim.sayLn+    >>> liftByline++-- | Read a line of input after printing the given stylized text as a+-- prompt.+--+-- @since 1.0.0.0+askLn ::+  (MonadByline m, ToStylizedText a) =>+  -- | The prompt.+  a ->+  -- | The text to return if the user does not enter a response.+  Maybe Text ->+  -- | User input (or default answer).+  m Text+askLn prompt def = liftByline (Prim.askLn (toStylizedText prompt) def)++-- | Read a single character of input.+--+-- @since 1.0.0.0+askChar ::+  (MonadByline m, ToStylizedText a) =>+  -- | The prompt to display.+  a ->+  m Char+askChar =+  toStylizedText+    >>> Prim.askChar+    >>> liftByline++-- | Read a password without echoing it to the terminal.  If a masking+-- character is given it will replace each typed character.+--+-- @since 1.0.0.0+askPassword ::+  (MonadByline m, ToStylizedText a) =>+  -- | The prompt to display.+  a ->+  -- | Optional masking character that will be printed each time the+  -- user presses a key.  When 'Nothing' is given the default behavior+  -- will be used which is system dependent but usually results in no+  -- characters being echoed to the terminal.+  Maybe Char ->+  m Text+askPassword prompt =+  Prim.askPassword (toStylizedText prompt)+    >>> liftByline++-- | Continue to prompt for a response until a confirmation function+-- returns a valid result.+--+-- @since 1.0.0.0+askUntil ::+  (MonadByline m, ToStylizedText a, ToStylizedText e) =>+  -- | The prompt to display.+  a ->+  -- | The default answer if the user presses enter without typing+  -- anything.+  Maybe Text ->+  -- | A function to validate the user input.  If the user input is+  -- acceptable the function should return 'Right'.  If the input is+  -- invalid then it should return 'Left' with an error message to+  -- display.  The error message will be printed with 'sayLn'.+  (Text -> m (Either e b)) ->+  m b+askUntil prompt def confirm = go+  where+    go = do+      answer <- askLn prompt def+      confirm answer >>= \case+        Left msg -> sayLn msg >> go+        Right res -> pure res++-- $use+--+--  Byline provides a monad transformer that allows you to compose+-- interactive terminal actions.  When producing output,+-- these actions accept stylized text that can include+-- foreground and background colors, underlined text, and+-- bold text.+--+-- Stylized text can be constructed with string literals+-- (using the @OverloadedStrings@ extension) or using the+-- 'text' function.  Attributes such as color can be changed+-- using modifier functions and the 'Semigroup' @(<>)@ operator.+--+-- Actions that read user input can work with completion+-- functions which are activated when the user presses the+-- tab key.  Most input actions also support default values+-- that will be returned when the user presses the enter key+-- without providing any input.+--+-- Example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+--+-- example :: MonadByline m => m Text+-- example = do+--   sayLn ("Hey, I like " <> ("Haskell" <> fg magenta) <> "!")+--+--   let question =+--         "What's "+--           <> ("your" <> bold)+--           <> " favorite "+--           <> ("language" <> fg green <> underline)+--           <> "? "+--+--   askLn question (Just "Haskell")+-- @+--+-- More complete examples can be found in the @examples@+-- directory of the distribution tarball or in the+-- repository.

@@ -0,0 +1,49 @@+-- |+--+-- 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 Byline.Completion+  ( -- * A Note About Completion+    -- $use++    -- * Completion Function+    CompletionFunc,+    Completion (..),++    -- * Setting the Active Completion Function+    pushCompletionFunction,+    popCompletionFunction,+  )+where++import Byline.Internal.Completion+import Byline.Internal.Eval (MonadByline (..))+import qualified Byline.Internal.Prim as Prim++-- | Add a 'CompletionFunc' to the stack.+--+-- @since 1.0.0.0+pushCompletionFunction :: MonadByline m => CompletionFunc IO -> m ()+pushCompletionFunction = Prim.pushCompFunc >>> liftByline++-- | Remove the top completion function from the stack.+--+-- @since 1.0.0.0+popCompletionFunction :: MonadByline m => m ()+popCompletionFunction = liftByline Prim.popCompFunc++-- $use+--+-- Haskeline makes it very difficult (if not impossible) to implement+-- a completion function that runs in an arbitrary monad.  More+-- information can be found in the documentation for 'CompletionFunc'.

@@ -0,0 +1,65 @@+-- |+--+-- 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 Byline.Exit+  ( -- * Exiting with style+    die,++    -- * Warnings+    warn,++    -- * Re-exports+    module Byline,+  )+where++import Byline+import Byline.Internal.Eval (defaultRenderMode)+import Byline.Internal.Stylized (render)+import qualified System.Environment as Environment+import qualified System.Exit as Exit+import qualified System.IO as IO+import Prelude hiding (die)++-- | Exit the current process after printing a pretty error message.+--+-- This function is similar to 'Exit.die' except that the name of the+-- current process along with a 'Stylized' error message is printed to+-- the standard error handle before exiting with a failure code.+--+-- @since 1.0.0.0+die :: (MonadIO m, ToStylizedText a) => a -> m b+die a = do+  warn a+  liftIO (IO.hFlush stderr >> Exit.exitFailure)++-- | Print a message to standard error.+--+-- Unlike 'die', this function will __not__ exit the current process.+--+-- @since 1.0.0.0+warn :: (MonadIO m, ToStylizedText a) => a -> m ()+warn a = liftIO $ do+  name <- Environment.getProgName <&> toText++  let msg =+        mconcat+          [ text name,+            ": ",+            toStylizedText a,+            "\n"+          ]++  mode <- defaultRenderMode stderr+  render mode stderr msg

@@ -0,0 +1,165 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Color+  ( Color (..),+    black,+    red,+    green,+    yellow,+    blue,+    magenta,+    cyan,+    white,+    rgb,+    colorAsANSI,+    colorAsIndex256,+    colorAsRGB,+    nearestColor,+    term256Locations,+  )+where++import Byline.Internal.Types+import qualified Data.Colour.CIE as C+import qualified Data.Colour.SRGB as C+import qualified System.Console.ANSI as ANSI++-- | Standard ANSI color by name.+--+-- @since 1.0.0.0+black, red, green, yellow, blue, magenta, cyan, white :: Color+black = ColorCode ANSI.Black+red = ColorCode ANSI.Red+green = ColorCode ANSI.Green+yellow = ColorCode ANSI.Yellow+blue = ColorCode ANSI.Blue+magenta = ColorCode ANSI.Magenta+cyan = ColorCode ANSI.Cyan+white = ColorCode ANSI.White++-- | Specify a color using a RGB triplet where each component is in+-- the range @[0 .. 255]@.  The actual rendered color will depend on+-- the terminal.+--+-- If the terminal advertises that it supports 256 colors, the color+-- given to this function will be converted to the nearest color in+-- the 216-color pallet supported by the terminal.  (216 colors+-- because the first 16 are the standard colors and the last 24 are+-- grayscale entries.)+--+-- However, if the terminal doesn't support extra colors, or doesn't+-- have a @TERMINFO@ entry (e.g., Windows) then the nearest standard+-- color will be chosen.+--+-- Nearest colors are calculated using their CIE distance from one+-- another.+--+-- See also:+--+--   * <http://en.wikipedia.org/wiki/ANSI_escape_code>+--   * <http://en.wikipedia.org/wiki/Color_difference>+--+-- @since 1.0.0.0+rgb :: Word8 -> Word8 -> Word8 -> Color+rgb r g b = ColorRGB (r, g, b)++-- | Convert a Byline color to an ANSI color.+--+-- @since 1.0.0.0+colorAsANSI :: Color -> ANSI.Color+colorAsANSI (ColorCode c) = c+colorAsANSI (ColorRGB c) = nearestColor c ansiColorLocations++-- | Convert a Byline color to an index into a terminal 256-color palette.+--+-- @since 1.0.0.0+colorAsIndex256 :: Color -> Word8+colorAsIndex256 = \case+  ColorCode c -> ANSI.xtermSystem ANSI.Dull c+  ColorRGB c -> nearestColor c term256Locations++-- | Convert a Byline color to a 'C.Colour'.  If the color is+-- specified using an ANSI color name then return that color code+-- instead.  This allows the terminal to pick the color on its own.+--+-- @since 1.0.0.0+colorAsRGB :: Color -> Either ANSI.Color (C.Colour Float)+colorAsRGB = \case+  ColorCode c -> Left c+  ColorRGB (r, g, b) -> Right (C.sRGB24 r g b)++-- | Find the nearest color given a full RGB color.+--+-- @since 1.0.0.0+nearestColor ::+  Bounded a =>+  -- | Original color.+  (Word8, Word8, Word8) ->+  -- | List of colors and locations.+  [(a, (Double, Double, Double))] ->+  -- | Destination color.+  a+nearestColor (r, g, b) table =+  case listToMaybe (sortColors $ distances table) of+    Nothing -> minBound -- Should never happen.+    Just (c, _) -> c+  where+    location :: (Double, Double, Double)+    location = C.cieXYZView (C.sRGB24 r g b)+    distance :: (Double, Double, Double) -> (Double, Double, Double) -> Double+    distance (x1, y1, z1) (x2, y2, z2) = sqrt ((x ** 2) + (y ** 2) + (z ** 2))+      where+        x = x1 - x2+        y = y1 - y2+        z = z1 - z2+    distances :: [(a, (Double, Double, Double))] -> [(a, Double)]+    distances = map (second (distance location))+    sortColors :: [(a, Double)] -> [(a, Double)]+    sortColors = sortBy (comparing snd)++-- | Get the CIE locations for the standard ANSI colors.+--+-- Locations are based on the default xterm colors.  See also:+--+--  * <http://en.wikipedia.org/wiki/ANSI_escape_code>+--  * <http://en.wikipedia.org/wiki/Color_difference>+--+-- @since 1.0.0.0+ansiColorLocations :: [(ANSI.Color, (Double, Double, Double))]+ansiColorLocations =+  [ (ANSI.Black, (0.0, 0.0, 0.0)),+    (ANSI.Red, (0.2518, 0.1298, 0.0118)),+    (ANSI.Green, (0.2183, 0.4366, 0.0728)),+    (ANSI.Yellow, (0.4701, 0.5664, 0.0846)),+    (ANSI.Blue, (0.1543, 0.0617, 0.8126)),+    (ANSI.Magenta, (0.3619, 0.1739, 0.592)),+    (ANSI.Cyan, (0.3285, 0.4807, 0.653)),+    (ANSI.White, (0.7447, 0.7835, 0.8532))+  ]++-- | All of the allowed colors for 256 color terminals.+--+-- @since 1.0.0.0+term256Locations :: [(Word8, (Double, Double, Double))]+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)

@@ -0,0 +1,118 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Completion+  ( CompletionFunc,+    Completion (..),+    runCompletionFunction,+    runCompletionFunctions,+  )+where++import qualified Data.Text as Text+import qualified System.Console.Haskeline.Completion as Haskeline++-- | A completion function modeled after the one used in Haskeline.+--+-- /Warning:/ If you're familiar with the Haskeline version of the+-- @CompletionFunc@ type please be sure to read this description+-- carefully since the two behave differently.+--+-- The completion function is called when the user presses the tab+-- key.  The current input line is split into two parts based on where+-- the cursor is positioned.  Text to the left of the cursor will be+-- the first value in the tuple and text to the right of the cursor+-- will be the second value.+--+-- The text returned from the completion function is the text from the+-- left of the cursor which wasn't used in the completion.  It should+-- also produce a list of possible 'Completion' values.+--+-- In Haskeline, some of these text values are reversed.  This is+-- /not/ the case in Byline.+--+-- /A note about @IO@:/+--+-- Due to Haskeline, the completion function is forced to return an+-- @IO@ value.  It would be better if it could return a value in the+-- base monad instead but it doesn't look like that's possible.+-- Patches welcome.+--+-- @since 1.0.0.0+type CompletionFunc m = (Text, Text) -> m (Text, [Completion])++-- | A type representing a completion match to the user's input.+--+-- @since 1.0.0.0+data Completion = Completion+  { -- | Text to insert to the right of the cursor.+    replacement :: Text,+    -- | Text to display when listing all completions.+    display :: Text,+    -- | Whether to follow the completed word with a+    --  terminating space or close existing quotes.+    isFinished :: Bool+  }+  deriving (Eq, Ord, Show)++-- | Convert a Byline completion result into a Haskeline completion result.+--+-- @since 1.0.0.0+convertCompletion :: Completion -> Haskeline.Completion+convertCompletion (Completion r d i) =+  Haskeline.Completion+    { Haskeline.replacement = toString r,+      Haskeline.display = toString d,+      Haskeline.isFinished = i+    }++-- | Adapt a completion function so it works with Haskeline.+--+-- @since 1.0.0.0+runCompletionFunction ::+  Monad m =>+  CompletionFunc m ->+  Haskeline.CompletionFunc m+runCompletionFunction comp (left, right) = do+  (output, completions) <-+    comp+      ( Text.reverse $ toText left,+        toText right+      )+  pure+    ( toString $ Text.reverse output,+      map convertCompletion completions+    )++-- | Run a list of completion functions, returning the results of the+-- first function that produced any.+--+-- @since 1.0.0.0+runCompletionFunctions ::+  forall m.+  Monad m =>+  [CompletionFunc m] ->+  Haskeline.CompletionFunc m+runCompletionFunctions fs input =+  foldlM go (mempty, mempty) fs+  where+    go ::+      (String, [Haskeline.Completion]) ->+      CompletionFunc m ->+      m (String, [Haskeline.Completion])+    go prev f = case prev of+      (_, []) -> runCompletionFunction f input+      _ -> pure prev

@@ -0,0 +1,254 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Eval+  ( MonadByline (..),+    BylineT,+    runBylineT,+    Settings (..),+    defaultBylineSettings,+    runBylineT',+    defaultRenderMode,+  )+where++import Byline.Internal.Completion+import Byline.Internal.Prim (PrimF (..))+import Byline.Internal.Stylized+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)+import Control.Monad.Cont (ContT, MonadCont)+import Control.Monad.Except (MonadError)+import qualified Control.Monad.State.Lazy as LState+import qualified Control.Monad.Trans.Free.Church as Free+import qualified System.Console.ANSI as ANSI+import qualified System.Console.Haskeline as Haskeline+import qualified System.Environment as System+import qualified System.Terminfo as Terminfo+import qualified System.Terminfo.Caps as Terminfo++-- | A class of types that can lift Byline operations into a base+-- monad.+--+-- @since 1.0.0.0+class Monad m => MonadByline (m :: * -> *) where+  liftByline :: Free.F PrimF a -> m a+  default liftByline :: (MonadTrans t, MonadByline m1, m ~ t m1) => Free.F PrimF a -> m a+  liftByline = lift . liftByline++instance MonadByline m => MonadByline (ExceptT e m)++instance MonadByline m => MonadByline (StateT s m)++instance MonadByline m => MonadByline (LState.StateT s m)++instance MonadByline m => MonadByline (ReaderT r m)++instance MonadByline m => MonadByline (IdentityT m)++instance MonadByline m => MonadByline (ContT r m)++-- | A monad transformer that implements 'MonadByline'.+--+-- @since 1.0.0.0+newtype BylineT m a = BylineT+  {unBylineT :: Free.FT PrimF m a}+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadState s,+      MonadReader r,+      MonadError e,+      MonadCont,+      MonadThrow,+      MonadCatch+    )++instance MonadTrans BylineT where+  lift = BylineT . lift++instance MonadByline (BylineT m) where+  liftByline = BylineT . Free.fromF++-- | Mutable list of completion functions.+--+-- @since 1.0.0.0+type CompRef m = IORef [CompletionFunc m]++-- | Discharge the 'MonadByline' effect by running all operations and+-- returning the result in the base monad.+--+-- The result is wrapped in a 'Maybe' where a 'Nothing' value+-- indicates that an end-of-file (EOF) signal was received while+-- reading user input.+--+-- @since 1.0.0.0+runBylineT ::+  (MonadIO m, MonadMask m) =>+  BylineT m a ->+  m (Maybe a)+runBylineT = runBylineT' defaultBylineSettings++-- | Settings that control Byline at run time.+--+-- @since 1.0.0.0+data Settings = Settings+  { -- | The output handle to write to.  If 'Nothing' use standard+    -- output.+    --+    -- NOTE: This only affects Byline (i.e. functions that use+    -- @say@).  Functions like @ask@ that invoke Haskeline will always+    -- use standard output since that's the hard-coded default.+    bylineOutput :: Maybe Handle,+    -- | The input handle to read from.  If 'Nothing' use standard+    -- input.+    bylineInput :: Maybe Handle,+    -- | Override the detected render mode.+    --+    -- If 'Nothing' use the render mode that is calculated based on+    -- the type of handle Byline writes to.+    bylineMode :: Maybe RenderMode+  }++-- | The default Byline settings.+--+-- @since 1.0.0.0+defaultBylineSettings :: Settings+defaultBylineSettings = Settings Nothing Nothing Nothing++-- | Like 'runBylineT' except you can override the settings.+--+-- @since 1.0.0.0+runBylineT' ::+  forall m a.+  (MonadIO m, MonadMask m) =>+  Settings ->+  BylineT m a ->+  m (Maybe a)+runBylineT' Settings {..} m = do+  compRef <- newIORef []+  let settings =+        Haskeline.setComplete+          (compFunc compRef)+          Haskeline.defaultSettings+  let behavior =+        maybe+          Haskeline.defaultBehavior+          Haskeline.useFileHandle+          bylineInput+  let hOut = fromMaybe stdout bylineOutput+  Haskeline.runInputTBehavior behavior settings (go compRef hOut)+  where+    compFunc :: CompRef IO -> Haskeline.CompletionFunc m+    compFunc compRef input = liftIO $+      readIORef compRef >>= \case+        [] -> Haskeline.completeFilename input+        fs -> runCompletionFunctions fs input+    go ::+      CompRef IO ->+      Handle ->+      Haskeline.InputT m (Maybe a)+    go compRef hOut = do+      mode <- maybe (liftIO (defaultRenderMode hOut)) pure bylineMode+      unBylineT m+        & evalPrimF mode hOut compRef+        & unEvalT+        & runMaybeT++-- | Internal transformer for evaluating primitive operations in the+-- 'Haskeline.InputT' transformer with EOF handling.+--+-- @since 1.0.0.0+newtype EvalT m a = EvalT+  {unEvalT :: MaybeT (Haskeline.InputT m) a}+  deriving newtype (Functor, Applicative, Monad, MonadIO)++instance MonadTrans EvalT where+  lift = EvalT . lift . lift++-- | Evaluate 'PrimF' values.+--+-- @since 1.0.0.0+evalPrimF ::+  forall m a.+  (MonadIO m, MonadMask m) =>+  RenderMode ->+  Handle ->+  CompRef IO ->+  Free.FT PrimF m a ->+  EvalT m a+evalPrimF renderMode outputHandle compRef = Free.iterTM go+  where+    go ::+      PrimF (EvalT m a) ->+      EvalT m a+    go = \case+      Say s k ->+        liftIO (render renderMode outputHandle s) >> k+      AskLn s d k -> do+        let prompt =+              renderText renderMode $+                maybe s (\d' -> s <> text "[" <> text d' <> "] ") d+        liftHaskeline (Haskeline.getInputLine (toString prompt)) >>= \case+          Nothing -> EvalT empty+          Just answer+            | null answer -> k (fromMaybe mempty d)+            | otherwise -> k (toText answer)+      AskChar s k -> do+        let prompt = toString (renderText renderMode s)+        liftHaskeline (Haskeline.getInputChar prompt) >>= \case+          Nothing -> EvalT empty+          Just c -> k c+      AskPassword s m k -> do+        let prompt = toString (renderText renderMode s)+        liftHaskeline (Haskeline.getPassword m prompt) >>= \case+          Nothing -> EvalT empty+          Just str -> k (toText str)+      PushCompFunc f k ->+        modifyIORef' compRef (f :) >> k+      PopCompFunc k ->+        modifyIORef'+          compRef+          ( \case+              [] -> []+              (_ : fs) -> fs+          )+          >> k+    liftHaskeline :: Haskeline.InputT m b -> EvalT m b+    liftHaskeline = Haskeline.withInterrupt >>> lift >>> EvalT++-- | Calculate the default rendering mode based on the terminal type.+defaultRenderMode :: Handle -> IO RenderMode+defaultRenderMode hOut = do+  isTerm <- ANSI.hSupportsANSI hOut+  if isTerm+    then runMaybeT getMaxColors >>= \case+      Nothing -> pure Simple+      Just n+        | n < 256 -> pure Simple+        | n > 256 -> pure TermRGB+        | otherwise -> pure Term256+    else pure Plain+  where+    getMaxColors :: MaybeT IO Int+    getMaxColors = do+      term <- MaybeT (System.lookupEnv "TERM")+      lift (Terminfo.acquireDatabase term) >>= \case+        Left _ -> empty+        Right db ->+          hoistMaybe $+            Terminfo.queryNumTermCap db Terminfo.MaxColors

@@ -0,0 +1,87 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Prim+  ( PrimF (..),+    say,+    sayLn,+    askLn,+    askChar,+    askPassword,+    pushCompFunc,+    popCompFunc,+  )+where++import Byline.Internal.Completion (CompletionFunc)+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.+--+-- @since 1.0.0.0+data PrimF f+  = Say (Stylized Text) f+  | AskLn (Stylized Text) (Maybe Text) (Text -> f)+  | AskChar (Stylized Text) (Char -> f)+  | AskPassword (Stylized Text) (Maybe Char) (Text -> f)+  | PushCompFunc (CompletionFunc IO) f+  | PopCompFunc f+  deriving (Functor)++-- | Smart constructor.+--+-- @since 1.0.0.0+say :: MonadFree PrimF m => Stylized Text -> m ()+say = Free.liftF . (`Say` ())++-- | Smart constructor.+--+-- @since 1.0.0.0+sayLn :: MonadFree PrimF m => Stylized Text -> m ()+sayLn message = say (message <> text "\n")++-- | Smart constructor.+--+-- @since 1.0.0.0+askLn :: MonadFree PrimF m => Stylized Text -> Maybe Text -> m Text+askLn prompt def = Free.liftF (AskLn prompt def id)++-- | Smart constructor.+--+-- @since 1.0.0.0+askChar :: MonadFree PrimF m => Stylized Text -> m Char+askChar = Free.liftF . (`AskChar` id)++-- | Smart constructor.+--+-- @since 1.0.0.0+askPassword :: MonadFree PrimF m => Stylized Text -> Maybe Char -> m Text+askPassword prompt mask = Free.liftF (AskPassword prompt mask id)++-- | Smart constructor.+--+-- @since 1.0.0.0+pushCompFunc :: MonadFree PrimF m => CompletionFunc IO -> m ()+pushCompFunc = Free.liftF . (`PushCompFunc` ())++-- | Smart constructor.+--+-- @since 1.0.0.0+popCompFunc :: MonadFree PrimF m => m ()+popCompFunc = Free.liftF (PopCompFunc ())

@@ -0,0 +1,164 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Simulation+  ( Simulated (..),+    SimulationFunction,+    SimulationState (..),+    BylineT (..),+    runBylineT,+  )+where++import Byline.Internal.Completion+import Byline.Internal.Eval (MonadByline (..))+import Byline.Internal.Prim+import Byline.Internal.Stylized+import Control.Monad.Catch (MonadCatch, MonadThrow)+import Control.Monad.Cont (MonadCont)+import Control.Monad.Except (MonadError)+import qualified Control.Monad.Trans.Free.Church as Free+import qualified Data.Text as Text++-- | Simulated user input.+--+-- @since 1.0.0.0+data Simulated+  = -- | Simulate user input by providing the 'Text' value+    -- they typed as a response to a prompt.+    --+    -- If the asking function wants a single character of input then+    -- only the first character of the provided 'Text' is used.  In+    -- this case, if an empty 'Text' value is given, it will be treated+    -- as an end-of-file (EOF) character.+    SimulatedInput Text+  | -- | Simulate an end-of-file (EOF) character.  Usually this occurs+    -- when the user enters @Control-D@ or when standard input is+    -- exhausted.+    SimulatedEOF++-- | A function that simulates user input by returning a 'Simulated'+-- value.+--+-- The function has full access to the 'SimulationState' including the+-- ability to change the simulation function itself.  For example,+-- below is a function that will return the text \"Current" the first+-- time it is called and \"Next" every time after that.+--+-- @+--+--  textThenDefault :: Monad m => SimulationFunction m+--  textThenDefault = do+--    -- The next input request will come from this function:+--    modify (\s -> s {simulationFunction = pure (SimulatedInput \"Next")})+--+--    -- But this time we'll return different text:+--    pure (SimulatedInput \"Current")+-- @+--+-- @since 1.0.0.0+type SimulationFunction m = StateT (SimulationState m) m Simulated++-- | Stateful information available to the simulation function.+--+-- @since 1.0.0.0+data SimulationState m = SimulationState+  { -- | The prompt associated with current request for input.  This+    -- 'Text' value will /not/ contain any formatting escape codes such+    -- as colors.+    precedingPrompt :: Text,+    -- | The function that will be called to simulate user input.+    simulationFunction :: SimulationFunction m,+    -- | The stack of completion functions.+    completionFunctions :: [CompletionFunc IO]+  }++-- | A monad transformer that implements the 'MonadByline' class+-- without actually doing anything.+--+-- @since 1.0.0.0+newtype BylineT m a = BylineT+  {unBylineT :: MaybeT (StateT (SimulationState m) m) a}+  deriving newtype+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadReader r,+      MonadError e,+      MonadCont,+      MonadThrow,+      MonadCatch+    )++instance MonadState s m => MonadState s (BylineT m) where+  state = lift . state++instance MonadTrans BylineT where+  lift = BylineT . lift . lift++instance Monad m => MonadByline (BylineT m) where+  liftByline = evalPrimF++-- | Evaluate a 'PrimF' instruction.+--+-- @since 1.0.0.0+evalPrimF :: forall m a. Monad m => Free.F PrimF a -> BylineT m a+evalPrimF = Free.iterM go+  where+    go :: PrimF (BylineT m a) -> BylineT m a+    go = \case+      Say _ k -> k+      AskLn s d k -> simulate s $ \t ->+        if Text.null t+          then k (fromMaybe t d)+          else k t+      AskChar s k -> simulate s $ \t ->+        if Text.null t+          then BylineT empty+          else k (Text.head t)+      AskPassword s _ k -> simulate s k+      PushCompFunc f k ->+        BylineT+          ( lift . modify $ \st ->+              st {completionFunctions = f : completionFunctions st}+          )+          >> k+      PopCompFunc k ->+        BylineT+          ( lift . modify $ \st ->+              case completionFunctions st of+                [] -> st {completionFunctions = []}+                _ : xs -> st {completionFunctions = xs}+          )+          >> k+    simulate :: Stylized Text -> (Text -> BylineT m b) -> BylineT m b+    simulate s f = do+      BylineT (modify $ \st -> st {precedingPrompt = renderText Plain s})+      simfun <- BylineT (gets simulationFunction)+      BylineT (lift simfun) >>= \case+        SimulatedInput t -> f t+        SimulatedEOF -> BylineT empty++-- | Discharge the 'MonadByline' effect using the given 'SimulationFunction'.+--+-- @since 1.0.0.0+runBylineT :: Monad m => SimulationFunction m -> BylineT m a -> m (Maybe a)+runBylineT f =+  unBylineT+    >>> runMaybeT+    >>> (`evalStateT` SimulationState "" f [])

@@ -0,0 +1,248 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Stylized+  ( Stylized (..),+    ToStylizedText (..),+    text,+    fg,+    bg,+    bold,+    underline,+    swapFgBg,+    RenderMode (..),+    render,+    renderText,+  )+where++import Byline.Internal.Color (Color)+import qualified Byline.Internal.Color as Color+import Byline.Internal.Types (Modifier (..), OnlyOne (..), Status (..))+import qualified Data.Text.IO as Text+import qualified System.Console.ANSI as ANSI++-- | A stylized value.  Construct text with modifiers using string+-- literals and the @OverloadedStrings@ extension and/or the 'text'+-- function.+--+-- @since 1.0.0.0+data Stylized a+  = -- | Something to stylize.+    Stylized Modifier a+  | -- | Modify the next stylized value.+    StylizedMod Modifier+  | -- | Multiple stylized values.+    StylizedList [Stylized a]+  deriving (Show, Eq, Functor, Foldable, Traversable)++-- | @since 1.0.0.0+instance Semigroup (Stylized a) where+  -- StylizedText on LHS.+  (<>) a@(Stylized _ _) b@(Stylized _ _) = StylizedList [a, b]+  (<>) (Stylized m t) (StylizedMod m') = Stylized (m <> m') t+  (<>) a@(Stylized _ _) (StylizedList b) = StylizedList (a : b)+  -- StylizedMod on LHS.+  (<>) (StylizedMod m) (Stylized m' t) = Stylized (m <> m') t+  (<>) (StylizedMod m) (StylizedMod m') = StylizedMod (m <> m')+  (<>) m@(StylizedMod _) (StylizedList l) = StylizedList (map (m <>) l)+  -- StylizedList on LHS.+  (<>) (StylizedList l) t@(Stylized _ _) = StylizedList (l <> [t])+  (<>) (StylizedList l) m@(StylizedMod _) = StylizedList (map (<> m) l)+  (<>) (StylizedList l) (StylizedList l') = StylizedList (l <> l')++-- | @since 1.0.0.0+instance Monoid (Stylized a) where+  mempty = StylizedList []++-- | @since 1.0.0.0+instance IsString (Stylized Text) where+  fromString = text . toText++-- | A class for types that can be converted to 'Stylized' text.+class ToStylizedText a where+  toStylizedText :: a -> Stylized Text++-- | @since 1.0.0.0+instance ToStylizedText (Stylized Text) where+  toStylizedText = id++-- | Helper function to create stylized text.  If you enable the+-- @OverloadedStrings@ extension then you can create stylized text+-- directly without using this function.+--+-- This function is also helpful for producing stylized text from an+-- existing @Text@ value.+--+-- @since 1.0.0.0+text :: Text -> Stylized Text+text = Stylized mempty++-- | Set the foreground color.  For example:+--+-- @+--     "Hello World!" <> fg magenta+-- @+--+-- @since 1.0.0.0+fg :: Color -> Stylized Text+fg c = StylizedMod (mempty {modColorFG = OnlyOne (Just c)})++-- | Set the background color.+--+-- @since 1.0.0.0+bg :: Color -> Stylized Text+bg c = StylizedMod (mempty {modColorBG = OnlyOne (Just c)})++-- | Produce bold text.+--+-- @since 1.0.0.0+bold :: Stylized Text+bold = StylizedMod (mempty {modBold = On})++-- | Produce underlined text.+--+-- @since 1.0.0.0+underline :: Stylized Text+underline = StylizedMod (mempty {modUnderline = On})++-- | Produce swapped foreground/background text.+--+-- @since 1.0.0.0+swapFgBg :: Stylized Text+swapFgBg = StylizedMod (mempty {modSwapFgBg = On})++-- | How to render stylized text.+--+-- @since 1.0.0.0+data RenderMode+  = -- | Text only, no modifiers.+    Plain+  | -- | Allow up to 8 colors.+    Simple+  | -- | Allow up to 216 colors.+    Term256+  | -- | A terminal that supports full RGB colors.+    TermRGB++-- | Instructions for formatting stylized text after the 'RenderMode'+-- has already been considered.+--+-- @since 1.0.0.0+data RenderInstruction+  = RenderText Text+  | RenderSGR [ANSI.SGR]++-- | Send stylized text to the given handle.+--+-- @since 1.0.0.0+render :: RenderMode -> Handle -> Stylized Text -> IO ()+render mode h stylized = mapM_ go (renderInstructions mode stylized)+  where+    go :: RenderInstruction -> IO ()+    go (RenderText t) = Text.hPutStr h t+    go (RenderSGR s) = ANSI.hSetSGR h s++-- | Render all modifiers as escape characters and return the+-- resulting text.  The text produced from this function is formatted+-- for output by Haskeline.+--+-- @since 1.0.0.0+renderText :: RenderMode -> Stylized Text -> Text+renderText mode stylized = foldMap go (renderInstructions mode stylized)+  where+    go :: RenderInstruction -> Text+    go = \case+      RenderText t -> t+      RenderSGR s ->+        -- NOTE: The \STX character below is not a real terminal+        -- escape character.  Instead it is intercepted by Haskeline.+        -- See: https://github.com/judah/haskeline/wiki/ControlSequencesInPrompt+        toText (ANSI.setSGRCode s) <> "\STX"++-- | Internal function to turn stylized text into render instructions.+--+-- @since 1.0.0.0+renderInstructions :: RenderMode -> Stylized Text -> [RenderInstruction]+renderInstructions mode = \case+  Stylized m t -> renderMod mode (t, m)+  StylizedMod _ -> []+  StylizedList xs -> concatMap (renderInstructions mode) xs+  where+    renderMod :: RenderMode -> (Text, Modifier) -> [RenderInstruction]+    renderMod mode (t, m) =+      case mode of+        Plain ->+          -- Only render text, no modifiers.+          [RenderText t]+        Simple ->+          -- Terminal supports basic 16 colors.+          let color l = ANSI.SetColor l ANSI.Dull . Color.colorAsANSI+           in renderToSGR t m color+        Term256 ->+          -- Terminal supports the 256-color palette.+          let color l = ANSI.SetPaletteColor l . Color.colorAsIndex256+           in renderToSGR t m color+        TermRGB ->+          -- Super terminal!+          let color l c = case Color.colorAsRGB c of+                Left ac -> ANSI.SetColor l ANSI.Dull ac+                Right rgb -> ANSI.SetRGBColor l rgb+           in renderToSGR t m color+    renderToSGR ::+      Text ->+      Modifier ->+      (ANSI.ConsoleLayer -> Color -> ANSI.SGR) ->+      [RenderInstruction]+    renderToSGR t m f =+      [ RenderSGR (modToSGR m f),+        RenderText t,+        RenderSGR [ANSI.Reset]+      ]++-- | Convert a modifier into a series of ANSI.SGR codes.+--+-- @since 1.0.0.0+modToSGR ::+  -- | The modifier to render as an SGR code.+  Modifier ->+  -- | A function that knows how to render colors.+  (ANSI.ConsoleLayer -> Color -> ANSI.SGR) ->+  -- | The resulting SGR codes.+  [ANSI.SGR]+modToSGR mod colorF =+  catMaybes+    [ colorF ANSI.Foreground <$> getColor modColorFG,+      colorF ANSI.Background <$> getColor modColorBG,+      ANSI.SetConsoleIntensity <$> getIntensity,+      ANSI.SetUnderlining <$> getUnderlining,+      ANSI.SetSwapForegroundBackground <$> getSwapForegroundBackground+    ]+  where+    getColor :: (Modifier -> OnlyOne Color) -> Maybe Color+    getColor f = unOne (f mod)+    getIntensity :: Maybe ANSI.ConsoleIntensity+    getIntensity = case modBold mod of+      Off -> Nothing+      On -> Just ANSI.BoldIntensity+    getUnderlining :: Maybe ANSI.Underlining+    getUnderlining = case modUnderline mod of+      Off -> Nothing+      On -> Just ANSI.SingleUnderline+    getSwapForegroundBackground :: Maybe Bool+    getSwapForegroundBackground = case modSwapFgBg mod of+      Off -> Nothing+      On -> Just True

@@ -0,0 +1,91 @@+{-# OPTIONS_HADDOCK hide #-}++-- |+--+-- 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 Byline.Internal.Types+  ( Color (..),+    Status (..),+    OnlyOne (..),+    Modifier (..),+  )+where++import qualified System.Console.ANSI as ANSI++-- | Opaque type for representing a color.+--+-- A color can be one of the eight standard terminal colors+-- constructed with one of the named color functions (e.g.,+-- 'Byline.black', 'Byline.red', etc.) or using the 'Byline.rgb'+-- function.+--+-- @since 1.0.0.0+data Color+  = ColorCode ANSI.Color+  | ColorRGB (Word8, Word8, Word8)+  deriving (Show, Eq)++-- | Like @Bool@, but with a different @Monoid@ instance.+--+-- @since 1.0.0.0+data Status = On | Off+  deriving (Show, Eq)++-- | @since 1.0.0.0+instance Semigroup Status where+  (<>) Off Off = Off+  (<>) Off On = On+  (<>) On On = On+  (<>) On Off = On++-- | @since 1.0.0.0+instance Monoid Status where+  mempty = Off++-- | Like @Maybe@, but with a different @Monoid@ instance.+--+-- @since 1.0.0.0+newtype OnlyOne a = OnlyOne {unOne :: Maybe a}+  deriving (Show, Eq)++-- | @since 1.0.0.0+instance Semigroup (OnlyOne a) where+  (<>) _ b@(OnlyOne (Just _)) = b+  (<>) a _ = a++-- | @since 1.0.0.0+instance Monoid (OnlyOne a) where+  mempty = OnlyOne Nothing++-- | Information about modifications made to stylized text.+--+-- @since 1.0.0.0+data Modifier = Modifier+  { modColorFG :: OnlyOne Color,+    modColorBG :: OnlyOne Color,+    modBold :: Status,+    modUnderline :: Status,+    modSwapFgBg :: Status+  }+  deriving (Show, Eq)++-- | @since 1.0.0.0+instance Semigroup Modifier where+  (<>) (Modifier a b c d e) (Modifier a' b' c' d' e') =+    Modifier (a <> a') (b <> b') (c <> c') (d <> d') (e <> e')++-- | @since 1.0.0.0+instance Monoid Modifier where+  mempty = Modifier mempty mempty mempty mempty mempty

@@ -0,0 +1,273 @@+-- |+--+-- 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 Byline.Menu+  ( -- * Menus with Tab Completion+    -- $usage++    -- * Building a Menu+    Menu,+    menu,+    menuBanner,+    menuPrefix,+    menuSuffix,+    FromChoice,+    menuFromChoiceFunc,++    -- * Prompting with a Menu+    askWithMenu,+    askWithMenuRepeatedly,+    Choice (..),++    -- * Re-exports+    module Byline,+  )+where++import Byline+import Byline.Completion+import Byline.Internal.Stylized (RenderMode (..), renderText)+import qualified Data.Text as Text+import Relude.Extra.Map+import Text.Printf (printf)++-- | Opaque type representing a menu containing items of type @a@.+--+-- @since 1.0.0.0+data Menu a = Menu+  { -- | Menu items.+    _menuItems :: NonEmpty a,+    -- | Banner printed before menu.+    _menuBanner :: Maybe (Stylized Text),+    -- | Stylize an item's index.+    _menuItemPrefix :: Int -> Stylized Text,+    -- | Printed after an item's index.+    _menuItemSuffix :: Stylized Text,+    -- | Printed before the prompt.+    _menuBeforePrompt :: Maybe (Stylized Text),+    -- | 'FromChoice' function.+    _menuItemFromChoiceFunc :: FromChoice a+  }++instance Foldable Menu where+  foldMap f Menu {..} = foldMap f _menuItems+  toList Menu {..} = toList _menuItems+  null _ = False+  length Menu {..} = length _menuItems++-- | A type representing the choice made by a user while working with+-- a menu.+--+-- @since 1.0.0.0+data Choice a+  = -- | User picked a menu item.+    Match a+  | -- | User entered text that doesn't match an item.+    Other Text+  deriving (Show, Eq, Functor, Foldable, Traversable)++-- | A function that is given the input from a user while working in a+-- menu and should translate that into a 'Choice'.+--+-- The @Map@ contains the menu item indexes/prefixes (numbers or+-- letters) and the items themselves.+--+-- The default 'FromChoice' function allows the user to select a menu+-- item by typing its index or part of its textual representation.  As+-- long as input from the user is a unique prefix of one of the menu+-- items then that item will be returned.+--+-- @since 1.0.0.0+type FromChoice a = Menu a -> Map Text a -> Text -> Choice a++-- | Default prefix generator.  Creates numbers aligned for two-digit+-- prefixes.+--+-- @since 1.0.0.0+numbered :: Int -> Stylized Text+numbered = text . Text.pack . printf "%2d"++-- | Helper function to produce a list of menu items matching the+-- given user input.+--+-- @since 1.0.0.0+matchOnPrefix :: ToStylizedText a => Menu a -> Text -> [a]+matchOnPrefix config input =+  filter prefixCheck (toList $ _menuItems config)+  where+    asText i = renderText Plain (toStylizedText i)+    prefixCheck i = input `Text.isPrefixOf` asText i++-- | Default 'FromChoice' function.  Checks to see if the user has input+-- a unique prefix for a menu item (matches the item text) or selected+-- one of the generated item prefixes (such as those generated by the+-- internal @numbered@ function).+--+-- @since 1.0.0.0+defaultFromChoice :: forall a. ToStylizedText a => FromChoice a+defaultFromChoice config prefixes input =+  case uniquePrefix <|> lookup cleanInput prefixes of+    Nothing -> Other input+    Just match -> Match match+  where+    cleanInput :: Text+    cleanInput = Text.strip input+    uniquePrefix :: Maybe a+    uniquePrefix =+      let matches = matchOnPrefix config cleanInput+       in if length matches == 1+            then listToMaybe matches+            else Nothing++-- | Default completion function.  Matches all of the menu items.+--+-- @since 1.0.0.0+defaultCompFunc :: (Applicative m, ToStylizedText a) => Menu a -> CompletionFunc m+defaultCompFunc config (left, _) =+  pure ("", completions matches)+  where+    -- All matching menu items.+    matches =+      if Text.null left+        then toList (_menuItems config)+        else matchOnPrefix config left+    -- Convert a menu item to a String.+    asText i = renderText Plain (toStylizedText i)+    -- Convert menu items into Completion values.+    completions = map (\i -> Completion (asText i) (asText i) True)++-- | Create a 'Menu' by giving a list of menu items and a function+-- that can convert those items into stylized text.+--+-- @since 1.0.0.0+menu :: ToStylizedText a => NonEmpty a -> Menu a+menu items =+  Menu+    { _menuItems = items,+      _menuBanner = Nothing,+      _menuItemPrefix = numbered,+      _menuItemSuffix = text ") ",+      _menuBeforePrompt = Nothing,+      _menuItemFromChoiceFunc = defaultFromChoice+    }++-- | Change the banner of a menu.  The banner is printed just before+-- the menu items are displayed.+--+-- @since 1.0.0.0+menuBanner :: ToStylizedText b => b -> Menu a -> Menu a+menuBanner b m = m {_menuBanner = Just (toStylizedText b)}++-- | Change the prefix function.  The prefix function should generate+-- unique, stylized text that the user can use to select a menu item.+-- The default prefix function numbers the menu items starting with 1.+--+-- @since 1.0.0.0+menuPrefix :: (Int -> Stylized Text) -> Menu a -> Menu a+menuPrefix f m = m {_menuItemPrefix = f}++-- | Change the menu item suffix.  It is displayed directly after the+-- menu item prefix and just before the menu item itself.+--+-- Default: @") "@+--+-- @since 1.0.0.0+menuSuffix :: Stylized Text -> Menu a -> Menu a+menuSuffix s m = m {_menuItemSuffix = s}++-- | Change the 'FromChoice' function.  The function should+-- compare the user's input to the menu items and their assigned+-- prefix values and return a 'Choice'.+--+-- @since 1.0.0.0+menuFromChoiceFunc :: FromChoice a -> Menu a -> Menu a+menuFromChoiceFunc f m = m {_menuItemFromChoiceFunc = f}++-- | Ask the user to choose an item from a menu.  The menu will only+-- be shown once and the user's choice will be returned in a 'Choice'+-- value.+--+-- If you want to force the user to only choose from the displayed+-- menu items you should use 'askWithMenuRepeatedly' instead.+--+-- @since 1.0.0.0+askWithMenu ::+  (MonadByline m, ToStylizedText a, ToStylizedText b) =>+  -- | The 'Menu' to display.+  Menu a ->+  -- | The prompt.+  b ->+  -- | The 'Choice' the user selected.+  m (Choice a)+askWithMenu m prompt =+  pushCompletionFunction (defaultCompFunc m)+    *> go+    <* popCompletionFunction+  where+    go = do+      prefixes <- displayMenu+      answer <- askLn prompt (Just firstItem)+      pure (_menuItemFromChoiceFunc m m prefixes answer)+    -- The default menu item.+    firstItem = Text.strip (renderText Plain (_menuItemPrefix m 1))+    -- Print the entire menu.+    displayMenu = do+      maybe pass ((<> "\n") >>> sayLn) (_menuBanner m)+      cache <- foldlM listItem mempty (zip [1 ..] (toList $ _menuItems m))+      sayLn (maybe mempty ("\n" <>) (_menuBeforePrompt m))+      pure cache+    -- Print a menu item and cache its prefix in a Map.+    listItem cache (index, item) = do+      let bullet = _menuItemPrefix m index+          rendered = renderText Plain bullet+      sayLn $+        mconcat+          [ text "  ", -- Indent.+            bullet, -- Unique identifier.+            _menuItemSuffix m, -- Spacer or marker.+            toStylizedText item -- The item.+          ]+      pure (one (Text.strip rendered, item) <> cache)++-- | Like 'askWithMenu' except that arbitrary input is not allowed.+-- If the user doesn't correctly select a menu item then the menu will+-- be repeated and an error message will be displayed.+--+-- @since 1.0.0.0+askWithMenuRepeatedly ::+  (MonadByline m, ToStylizedText a, ToStylizedText b, ToStylizedText e) =>+  -- | The 'Menu' to display.+  Menu a ->+  -- | The prompt.+  b ->+  -- | Error message when the user tried to select a non-menu item.+  e ->+  -- | The 'Choice' the user selected.+  m a+askWithMenuRepeatedly m prompt errprompt = go m+  where+    go config = do+      answer <- askWithMenu config prompt+      case answer of+        Other _ -> go (config {_menuBeforePrompt = Just (toStylizedText errprompt)})+        Match x -> pure x++-- $usage+--+-- Menus are used to provide the user with a choice of acceptable+-- values.  Each choice is labeled to make it easier for a user to+-- select it, or the user may enter text that does not correspond to+-- any of the menus items.+--+-- For an example see the @menu.hs@ file in the @examples@ directory.

@@ -0,0 +1,41 @@+-- |+--+-- 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 Byline.Simulation+  ( -- * Simulating User Interaction+    -- $use++    -- * Simulated Values+    Simulated (..),+    SimulationFunction,++    -- * Access to Simulation State+    SimulationState (..),++    -- * Simulation as a Monad Transformer+    BylineT,+    runBylineT,++    -- * Re-exports+    module Byline,+  )+where++import Byline hiding (BylineT, runBylineT)+import Byline.Internal.Simulation++-- $use+--+-- This module provides a monad transformer that can simulate an+-- interactive user session for testing 'MonadByline' code.

@@ -1,119 +0,0 @@-{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-----------------------------------------------------------------------------------module System.Console.Byline-       ( -- * Introduction-         ---         -- | Byline provides a monad transformer that allows you to compose-         -- interactive terminal actions.  When producing output,-         -- these actions accept stylized text that can include-         -- foreground and background colors, underlined text, and-         -- bold text.-         ---         -- Stylized text can be constructed with string literals-         -- (using the @OverloadedStrings@ extension) or using the-         -- 'text' function.  Attributes such as color can be changed-         -- using modifier functions and the @mappend@ operator,-         -- @(<>)@.-         ---         -- Actions that read user input can work with completion-         -- functions which are activated when the user presses the-         -- tab key.  Most input actions also support default values-         -- that will be returned when the user presses the enter key-         -- without providing any input.-         ---         -- Example:-         ---         -- @-         --     {-\# LANGUAGE OverloadedStrings \#-}-         ---         --     ...-         ---         --     language <- runByline $ do-         --         sayLn ("Look mom, " <> ("colors" <> fg blue) <> "!")-         ---         --         let question = "What's your favorite " <>-         --                        ("language" <> bold)    <> "? "-         ---         --         ask question Nothing-         -- @-         ---         -- More complete examples can be found in the @examples@-         -- directory of the distribution tarball or in the-         -- repository.--         -- * Executing Interactive Sessions-         Byline-       , runByline--         -- * Primitive Operations-       , say-       , sayLn-       , ask-       , askChar-       , askPassword-       , askUntil-       , report-       , reportLn--         -- * Constructing Stylized Text-       , Stylized-       , text--         -- * Modifying Output Text--         -- | The 'Stylized' type is an instance of the monoid class.-         -- This means you can change attributes of the text by using-         -- the following functions along with @mappend@ or the @(<>)@-         -- operator.-       , fg, bg, bold, underline, swapFgBg--         -- * Specifying Colors-       , Color-       , black, red, green, yellow, blue, magenta, cyan, white, rgb--         -- * Menus--         -- | Menus provide a way to display a small number of list items-         -- to the user.  The desired list item is selected by typing-         -- its index or by typing a unique prefix string.  A default-         -- completion function is provided to allow the user to-         -- select a list item using tab completion.-       , Menu-       , Choice (..)-       , menu-       , askWithMenu-       , askWithMenuRepeatedly-       , banner-       , prefix-       , suffix-       , Matcher-       , matcher--         -- * Completion-       , CompletionFunc-       , Completion (..)-       , withCompletionFunc--         -- * Utility Functions, Operators, and Types-       , ReportType (..)-       , (<>)-       ) where-----------------------------------------------------------------------------------import System.Console.Byline.Color-import System.Console.Byline.Completion-import System.Console.Byline.Internal.Byline-import System.Console.Byline.Menu-import System.Console.Byline.Modifiers-import System.Console.Byline.Primitive-import System.Console.Byline.Stylized

@@ -1,69 +0,0 @@-{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-------------------------------------------------------------------------------------- | Color type and functions for specifying colors.-module System.Console.Byline.Color-       ( Color (..)-       , black, red, green, yellow, blue, magenta, cyan, white-       , rgb-       ) where------------------------------------------------------------------------------------- Library imports:-import Data.Word-import qualified System.Console.ANSI as ANSI------------------------------------------------------------------------------------- | Opaque type for representing a color.------ A color can be one of the eight standard terminal colors--- constructed with one of the named color functions (e.g., 'black',--- 'red', etc.) or using the 'rgb' function.-data Color = ColorCode ANSI.Color | ColorRGB (Word8, Word8, Word8)------------------------------------------------------------------------------------- | Standard ANSI color by name.-black, red, green, yellow, blue, magenta, cyan, white :: Color-black   = ColorCode ANSI.Black-red     = ColorCode ANSI.Red-green   = ColorCode ANSI.Green-yellow  = ColorCode ANSI.Yellow-blue    = ColorCode ANSI.Blue-magenta = ColorCode ANSI.Magenta-cyan    = ColorCode ANSI.Cyan-white   = ColorCode ANSI.White------------------------------------------------------------------------------------- | Specify a color using a RGB triplet where each component is in--- the range @[0 .. 255]@.  The actual rendered color will depend on--- the terminal.------ If the terminal advertises that it supports 256 colors, the color--- given to this function will be converted to the nearest color in--- the 216-color pallet supported by the terminal.  (216 colors--- because the first 16 are the standard colors and the last 24 are--- grayscale entries.)------ However, if the terminal doesn't support extra colors, or doesn't--- have a @TERMINFO@ entry (e.g., Windows) then the nearest standard--- color will be chosen.------ Nearest colors are calculated using their CIE distance from one--- another.------ See also:------   * <http://en.wikipedia.org/wiki/ANSI_escape_code>---   * <http://en.wikipedia.org/wiki/Color_difference>-rgb :: Word8 -> Word8 -> Word8 -> Color-rgb r g b = ColorRGB (r, g, b)

@@ -1,57 +0,0 @@-{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | The completion types.-module System.Console.Byline.Completion-       ( CompletionFunc-       , Completion (..)-       ) where------------------------------------------------------------------------------------- Library imports:-import Data.Text (Text)------------------------------------------------------------------------------------- | A completion function modeled after the one used in Haskeline.------ /Warning:/ If you're familiar with the Haskeline version of the--- @CompletionFunc@ type please be sure to read this description--- carefully since the two behave differently.------ The completion function is called when the user presses the tab--- key.  The current input line is split into two parts based on where--- the cursor is positioned.  Text to the left of the cursor will be--- the first value in the tuple and text to the right of the cursor--- will be the second value.------ The text returned from the completion function is the text from the--- left of the cursor which wasn't used in the completion.  It should--- also produce a list of possible 'Completion' values.------ In Haskeline, some of these text values are reversed.  This is--- /not/ the case in Byline.------ /A note about @IO@:/------ Due to the way that Byline uses Haskeline, the completion function--- is forced to return an @IO@ value.  It would be better if it could--- return a value in the base monad instead.  Patches welcome.-type CompletionFunc = (Text, Text) -> IO (Text, [Completion])------------------------------------------------------------------------------------- | A type representing a completion match to the user's input.-data Completion = Completion-  { replacement :: Text -- ^ Text to insert to the right of the cursor.-  , display     :: Text -- ^ Text to display when listing all completions.-  , isFinished  :: Bool -- ^ Whether to follow the completed word with a-                        --  terminating space or close existing quotes.-  } deriving (Eq, Ord, Show)

@@ -1,153 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_HADDOCK hide #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Internal module containing the @Byline@ monad transformer.-module System.Console.Byline.Internal.Byline-       ( Byline (..)-       , Env    (..)-       , eof-       , liftBase-       , liftInputT-       , runByline-       ) where------------------------------------------------------------------------------------- Library imports:-import Control.Applicative-import Control.Monad.Catch-import Control.Monad.Reader-import Control.Monad.Trans.Maybe-import Data.IORef-import System.Environment (lookupEnv)-import System.IO (Handle, stdout)-import qualified System.Terminfo as Term-import qualified System.Terminfo.Caps as Term------------------------------------------------------------------------------------- Import Haskeline, which is used to do the heavy lifting.-import qualified System.Console.Haskeline    as H-import qualified System.Console.Haskeline.IO as H------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Internal.Completion-import System.Console.Byline.Internal.Render------------------------------------------------------------------------------------- The following is a kludge to avoid the "redundant import" warning--- when using GHC >= 7.10.x.  This should be removed after we decide--- to stop supporting GHC < 7.10.x.-import Prelude------------------------------------------------------------------------------------- | Reader environment for Byline.-data Env = Env-  { sayMode    :: RenderMode-  , askMode    :: RenderMode-  , outHandle  :: Handle-  , inputState :: H.InputState-  , compFunc   :: IORef (Maybe CompletionFunc)-  }------------------------------------------------------------------------------------- | A monad transformer that encapsulates interactive actions.-newtype Byline m a = Byline {unByline :: ReaderT Env (MaybeT m) a}-  deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)--instance MonadTrans Byline where-  lift = liftBase------------------------------------------------------------------------------------- | Calculate the default rendering modes based on the terminal type.-defRenderMode :: H.InputT IO (RenderMode, RenderMode)-defRenderMode = do-  termHint  <- H.haveTerminalUI-  maxColors <- liftIO (runMaybeT getMaxColors)--  return $ case (termHint, maxColors) of-             (True, Just n) | n < 256   -> (Simple,  Simple)-                            | otherwise -> (Term256, Term256)-             (True, Nothing)            -> (Simple,  Plain)-             (False, _)                 -> (Plain,   Plain)-  where-    getMaxColors :: MaybeT IO Int-    getMaxColors = do-      term <- MaybeT (lookupEnv "TERM")-      db   <- liftIO (Term.acquireDatabase term)--      case db of-        Left _  -> MaybeT (return Nothing)-        Right d -> MaybeT (return $ Term.queryNumTermCap d Term.MaxColors)------------------------------------------------------------------------------------- | Create the default reader environment.-defEnv :: H.InputState-       -> (RenderMode, RenderMode)-       -> IORef (Maybe CompletionFunc)-       -> Env-defEnv state (smode, amode) comp =-  Env { sayMode    = smode-      , askMode    = amode-      , outHandle  = stdout-      , inputState = state-      , compFunc   = comp-      }------------------------------------------------------------------------------------- | Signal an EOF and terminate all Byline actions.-eof :: (Monad m) => Byline m a-eof = Byline $ lift (MaybeT $ return Nothing)------------------------------------------------------------------------------------- | Lift an operation in the base monad into Byline.-liftBase :: (Monad m) => m a -> Byline m a-liftBase = Byline . lift . lift------------------------------------------------------------------------------------- | Lift an 'InputT' action into 'Byline'.-liftInputT :: (MonadIO m) => H.InputT IO a -> Byline m a-liftInputT input = do-  state <- asks inputState-  liftIO (H.queryInput state $ H.withInterrupt input)------------------------------------------------------------------------------------- | Execute 'Byline' actions and produce a result within the base monad.------ /A note about EOF:/------ If an End of File (EOF) is encountered during an input action then--- this function will return @Nothing@.  This can occur when the user--- manually enters an EOF character by pressing @Control-d@ or if--- standard input is a file.------ This decision was made to simplify the @Byline@ interface for--- actions that read user input and is a typical strategy for terminal--- applications.  If this isn't desirable, you may want to break your--- actions up into groups and call 'runByline' multiple times.-runByline :: (MonadIO m, MonadMask m) => Byline m a -> m (Maybe a)-runByline (Byline byline) = do-  comp <- liftIO (newIORef Nothing)-  let settings = H.setComplete (runCompletionFunction comp) H.defaultSettings--  bracketOnError (liftIO $ H.initializeInput settings) -- Acquire.-                 (liftIO . H.cancelInput)              -- Release.-                 (go comp)                             -- Use.-  where-    go comp state = do-      modes  <- liftIO (H.queryInput state defRenderMode)-      output <- runMaybeT $ runReaderT byline (defEnv state modes comp)--      liftIO (H.closeInput state)-      return output

@@ -1,101 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_HADDOCK hide #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-------------------------------------------------------------------------------------- | Internal color operations.-module System.Console.Byline.Internal.Color-       ( Color (..)-       , colorAsANSI-       , nearestColor-       , term256Locations-       ) where------------------------------------------------------------------------------------- Library imports:-import Control.Arrow (second)-import qualified Data.Colour.CIE as C-import qualified Data.Colour.SRGB as C-import Data.List (sortBy)-import Data.Maybe-import Data.Ord (comparing)-import Data.Word-import qualified System.Console.ANSI as ANSI------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Color------------------------------------------------------------------------------------- | Convert a Byline color to an ANSI color.-colorAsANSI :: Color -> ANSI.Color-colorAsANSI (ColorCode c) = c-colorAsANSI (ColorRGB  c) = nearestColor c ansiColorLocations------------------------------------------------------------------------------------- | Find the nearest color given a full RGB color.-nearestColor :: (Bounded a)-             => (Word8, Word8, Word8)           -- ^ Original color.-             -> [(a, (Double, Double, Double))] -- ^ List of colors and locations.-             -> a                               -- ^ Destination color.-nearestColor (r, g, b) table =-  case listToMaybe (sortColors $ distances table) of-    Nothing     -> minBound -- Should never happen.-    Just (c, _) -> c--  where-    location :: (Double, Double, Double)-    location = C.cieXYZView (C.sRGB24 r g b)--    distance :: (Double, Double, Double) -> (Double, Double, Double) -> Double-    distance (x1, y1, z1) (x2, y2, z2) = sqrt ((x ** 2) + (y ** 2) + (z ** 2))-      where x = x1 - x2-            y = y1 - y2-            z = z1 - z2--    distances :: [(a, (Double, Double, Double))] -> [(a, Double)]-    distances = map (second (distance location))--    sortColors :: [(a, Double)] -> [(a, Double)]-    sortColors = sortBy (comparing snd)------------------------------------------------------------------------------------- | Get the CIE locations for the standard ANSI colors.------ Locations are based on the default xterm colors.  See also:------  * <http://en.wikipedia.org/wiki/ANSI_escape_code>---  * <http://en.wikipedia.org/wiki/Color_difference>-ansiColorLocations :: [(ANSI.Color, (Double, Double, Double))]-ansiColorLocations = [ (ANSI.Black,   (0.0,    0.0,    0.0))-                     , (ANSI.Red,     (0.2518, 0.1298, 0.0118))-                     , (ANSI.Green,   (0.2183, 0.4366, 0.0728))-                     , (ANSI.Yellow,  (0.4701, 0.5664, 0.0846))-                     , (ANSI.Blue,    (0.1543, 0.0617, 0.8126))-                     , (ANSI.Magenta, (0.3619, 0.1739, 0.592))-                     , (ANSI.Cyan,    (0.3285, 0.4807, 0.653))-                     , (ANSI.White,   (0.7447, 0.7835, 0.8532))-                     ]------------------------------------------------------------------------------------- | All of the allowed colors for 256 color terminals.-term256Locations :: [(Word8, (Double, Double, Double))]-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)

@@ -1,55 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Internal completion operations.-module System.Console.Byline.Internal.Completion-       ( CompletionFunc-       , Completion (..)-       , runCompletionFunction-       ) where------------------------------------------------------------------------------------- Library imports:-import Data.IORef-import qualified Data.Text as Text-import qualified System.Console.Haskeline.Completion as H------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Completion------------------------------------------------------------------------------------- | Convert a Byline completion result into a Haskeline completion result.-convertCompletion :: Completion -> H.Completion-convertCompletion (Completion r d i) =-  H.Completion { H.replacement = Text.unpack r-               , H.display     = Text.unpack d-               , H.isFinished  = i-               }------------------------------------------------------------------------------------- | Helper function that allows Byline to swap out the completion function.-runCompletionFunction :: IORef (Maybe CompletionFunc) -> H.CompletionFunc IO-runCompletionFunction compref (left, right) = do-  comp <- readIORef compref--  case comp of-    Nothing -> H.completeFilename (left, right)--    Just f -> do-      (output, completions) <--        f (Text.reverse $ Text.pack left, Text.pack right)--      return (Text.unpack $ Text.reverse output,-              map convertCompletion completions)

@@ -1,155 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK hide #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Functions for turning stylized text into text or terminal commands.-module System.Console.Byline.Internal.Render-       ( RenderMode (..)-       , render-       , renderText-       ) where------------------------------------------------------------------------------------- Library imports:-import Control.Applicative-import Data.Maybe-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Word-import System.Console.ANSI as ANSI-import System.IO (Handle, hPutStr)------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Internal.Color as C-import System.Console.Byline.Internal.Types-import System.Console.Byline.Stylized------------------------------------------------------------------------------------- The following is a kludge to avoid the "redundant import" warning--- when using GHC >= 7.10.x.  This should be removed after we decide--- to stop supporting GHC < 7.10.x.-import Prelude------------------------------------------------------------------------------------- | How to render stylized text.-data RenderMode = Plain   -- ^ Text only, no modifiers.-                | Simple  -- ^ Allow up to 8 colors.-                | Term256 -- ^ Allow up to 216 colors.------------------------------------------------------------------------------------- | Instructions for formatting stylized text after the 'RenderMode'--- has already been considered.-data RenderInstruction = RenderText Text-                       | RenderSGR [SGR]------------------------------------------------------------------------------------- | Send stylized text to the given handle.  This works on Windows--- thanks to the @ansi-terminal@ package.-render :: RenderMode -> Handle -> Stylized -> IO ()-render mode h stylized = mapM_ go (renderInstructions mode stylized)-  where-    go :: RenderInstruction -> IO ()-    go (RenderText t) = hPutStr h (Text.unpack t)-    go (RenderSGR  s) = hSetSGR h s------------------------------------------------------------------------------------- | Render all modifiers as escape characters and return the--- resulting text.  On most terminals, sending this text to stdout--- will correctly render the modifiers.  However, this won't work on--- Windows consoles so you'll want to send 'Plain' as the 'RenderMode'.-renderText :: RenderMode -> Stylized -> Text-renderText mode stylized = Text.concat $ map go (renderInstructions mode stylized)-  where-    go :: RenderInstruction -> Text-    go (RenderText t) = t-    go (RenderSGR  _) = Text.empty------------------------------------------------------------------------------------- | Internal function to turn stylized text into render instructions.-renderInstructions :: RenderMode -> Stylized -> [RenderInstruction]-renderInstructions mode = concat . mapStylized renderMod-  where-    renderMod :: (Text, Modifier) -> [RenderInstruction]-    renderMod (t, m) =-      case mode of-        -- Only rendering text.-        Plain -> [ RenderText t ]--        -- Render text with modifiers.  The only difference between-        -- 'Simple' and 'Term256' is handled by 'modToText'.-        _     -> [ RenderSGR  (modToSGR m)-                 , RenderText (modToText mode m)-                 , RenderText t-                 , RenderSGR [Reset]-                 ]------------------------------------------------------------------------------------- | Convert a modifier into a series of SGR codes.-modToSGR :: Modifier -> [SGR]-modToSGR m =-  catMaybes [ SetColor Foreground Dull    <$> modColor modColorFG-            , SetColor Background Dull    <$> modColor modColorBG-            , SetConsoleIntensity         <$> modIntensity-            , SetUnderlining              <$> modUnderlining-            , SetSwapForegroundBackground <$> modSwapForegroundBackground-            ]--  where-    modColor :: (Modifier -> OnlyOne C.Color) -> Maybe ANSI.Color-    modColor f = C.colorAsANSI <$> unOne (f m)--    modIntensity :: Maybe ConsoleIntensity-    modIntensity = case modBold m of-      Off -> Nothing-      On  -> Just BoldIntensity--    modUnderlining :: Maybe Underlining-    modUnderlining = case modUnderline m of-      Off -> Nothing-      On  -> Just SingleUnderline--    modSwapForegroundBackground :: Maybe Bool-    modSwapForegroundBackground = case modSwapFgBg m of-      Off -> Nothing-      On  -> Just True-------------------------------------------------------------------------------------- | Convert modifiers into direct escape sequences for modifiers--- that can't be converted into SGR codes (e.g., RGB colors).------ See: <http://en.wikipedia.org/wiki/ANSI_escape_code#Colors>-modToText :: RenderMode -> Modifier -> Text-modToText Plain _   = Text.empty-modToText Simple _  = Text.empty-modToText Term256 m =-  Text.concat $ catMaybes [ escape Foreground <$> modColor modColorFG-                          , escape Background <$> modColor modColorBG-                          ]--  where-    modColor :: (Modifier -> OnlyOne C.Color) -> Maybe (Word8, Word8, Word8)-    modColor f = case unOne (f m) of-                   Just (ColorRGB c) -> Just c-                   _                 -> Nothing--    -- Produce the correct CSI escape.-    escape :: ConsoleLayer -> (Word8, Word8, Word8) -> Text-    escape Foreground c = Text.concat ["\ESC[38;5;", colorIndex c, "m"]-    escape Background c = Text.concat ["\ESC[48;5;", colorIndex c, "m"]--    -- Return the 216-color index for (r, g, b).-    colorIndex :: (Word8, Word8, Word8) -> Text-    colorIndex c = Text.pack $ show (nearestColor c term256Locations)

@@ -1,78 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Internal types.-module System.Console.Byline.Internal.Types-       ( Status   (..)-       , OnlyOne  (..)-       , Modifier (..)-       ) where------------------------------------------------------------------------------------- Library imports:-import qualified Data.Semigroup as Semi------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Color (Color)------------------------------------------------------------------------------------- | Like @Bool@, but with a different @Monoid@ instance.-data Status = On | Off-----------------------------------------------------------------------------------instance Semi.Semigroup Status where-  (<>) Off Off = Off-  (<>) Off On  = On-  (<>) On  On  = On-  (<>) On  Off = On-----------------------------------------------------------------------------------instance Monoid Status where-  mempty = Off-  mappend = (Semi.<>)------------------------------------------------------------------------------------- | Like @Maybe@, but with a different @Monoid@ instance.-newtype OnlyOne a = OnlyOne {unOne :: Maybe a}-----------------------------------------------------------------------------------instance Semi.Semigroup (OnlyOne a) where-  (<>) _ b@(OnlyOne (Just _)) = b-  (<>) a _                    = a-----------------------------------------------------------------------------------instance Monoid (OnlyOne a) where-  mempty = OnlyOne Nothing-  mappend = (Semi.<>)------------------------------------------------------------------------------------- | Information about modifications made to stylized text.-data Modifier = Modifier-  { modColorFG   :: OnlyOne Color-  , modColorBG   :: OnlyOne Color-  , modBold      :: Status-  , modUnderline :: Status-  , modSwapFgBg  :: Status-  }-----------------------------------------------------------------------------------instance Semi.Semigroup Modifier where-  (<>) (Modifier a b c d e) (Modifier a' b' c' d' e') =-    Modifier (a <> a') (b <> b') (c <> c') (d <> d') (e <> e')-----------------------------------------------------------------------------------instance Monoid Modifier where-  mempty = Modifier mempty mempty mempty mempty mempty-  mappend = (Semi.<>)

@@ -1,249 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Functions and types for working with menus.-module System.Console.Byline.Menu-       ( Menu-       , Choice (..)-       , Matcher-       , menu-       , banner-       , prefix-       , suffix-       , matcher-       , askWithMenu-       , askWithMenuRepeatedly-       ) where------------------------------------------------------------------------------------- Library imports:-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class-import qualified Control.Monad.Reader as Reader-import Data.IORef-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Maybe-import Data.Text (Text)-import qualified Data.Text as Text-import Text.Printf (printf)------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Internal.Byline-import System.Console.Byline.Internal.Completion-import System.Console.Byline.Internal.Render-import System.Console.Byline.Primitive-import System.Console.Byline.Stylized------------------------------------------------------------------------------------- | Opaque type representing a menu containing items of type @a@.-data Menu a = Menu-  { menuItems        :: [a]              -- ^ Menu items.-  , menuBanner       :: Maybe Stylized   -- ^ Banner printed before menu.-  , menuDisplay      :: a -> Stylized    -- ^ Stylize a menu item.-  , menuItemPrefix   :: Int -> Stylized  -- ^ Stylize an item's index.-  , menuItemSuffix   :: Stylized         -- ^ Printed after an item's index.-  , menuBeforePrompt :: Maybe Stylized   -- ^ Printed before the prompt.-  , menuMatcher      :: Matcher a        -- ^ Matcher function.-  }------------------------------------------------------------------------------------- | A type representing the choice made by a user while working with--- a menu.-data Choice a = NoItems    -- ^ Menu has no items to choose from.-              | Match a    -- ^ User picked a menu item.-              | Other Text -- ^ User entered text that doesn't match an item.-              deriving Show------------------------------------------------------------------------------------- | A function that is given the input from a user while working in a--- menu and should translate that into a 'Choice'.------ The @Map@ contains the menu item indexes/prefixes (numbers or--- letters) and the items themselves.------ The default matcher function allows the user to select a menu item--- by typing its index or part of its textual representation.  As long--- as input from the user is a unique prefix of one of the menu items--- then that item will be returned.-type Matcher a = Menu a -> Map Text a -> Text -> Choice a------------------------------------------------------------------------------------- | Default prefix generator.  Creates numbers aligned for two-digit--- prefixes.-numbered :: Int -> Stylized-numbered = text . Text.pack . printf "%2d"------------------------------------------------------------------------------------- | Helper function to produce a list of menu items matching the--- given user input.-matchOnPrefix :: Menu a -> Text -> [a]-matchOnPrefix config input = filter prefixCheck (menuItems config)-  where-    asText i      = renderText Plain (menuDisplay config i)-    prefixCheck i = input `Text.isPrefixOf` asText i------------------------------------------------------------------------------------- | Default 'Matcher' function.  Checks to see if the user has input--- a unique prefix for a menu item (matches the item text) or selected--- one of the generated item prefixes (such as those generated by the--- internal @numbered@ function).-defaultMatcher :: Matcher a-defaultMatcher config prefixes input =-  case uniquePrefix <|> Map.lookup cleanInput prefixes of-    Nothing    -> Other input-    Just match -> Match match--  where-    cleanInput = Text.strip input--    -- uniquePrefix :: Maybe a-    uniquePrefix = let matches = matchOnPrefix config cleanInput-                   in if length matches == 1-                        then listToMaybe matches-                        else Nothing------------------------------------------------------------------------------------- | Default completion function.  Matches all of the menu items.-defaultCompFunc :: Menu a -> CompletionFunc-defaultCompFunc config (left, _) = return ("", completions matches)-  where-    -- All matching menu items.-    matches = if Text.null left-                then menuItems config-                else matchOnPrefix config left--    -- Convert a menu item to a String.-    asText i = renderText Plain (menuDisplay config i)--    -- Convert menu items into Completion values.-    completions = map (\i -> Completion (asText i) (asText i) True)------------------------------------------------------------------------------------- | Create a 'Menu' by giving a list of menu items and a function--- that can convert those items into stylized text.-menu :: [a] -> (a -> Stylized) -> Menu a-menu items displayF =-  Menu { menuItems        = items-       , menuBanner       = Nothing-       , menuDisplay      = displayF-       , menuItemPrefix   = numbered-       , menuItemSuffix   = text ") "-       , menuBeforePrompt = Nothing-       , menuMatcher      = defaultMatcher-       }------------------------------------------------------------------------------------- | Change the banner of a menu.  The banner is printed just before--- the menu items are displayed.-banner :: Stylized -> Menu a -> Menu a-banner b m = m {menuBanner = Just b}------------------------------------------------------------------------------------- | Change the prefix function.  The prefix function should generate--- unique, stylized text that the user can use to select a menu item.--- The default prefix function numbers the menu items starting with 1.-prefix :: (Int -> Stylized) -> Menu a -> Menu a-prefix f m = m {menuItemPrefix = f}------------------------------------------------------------------------------------- | Change the menu item suffix.  It is displayed directly after the--- menu item prefix and just before the menu item itself.------ Default: @") "@-suffix :: Stylized -> Menu a -> Menu a-suffix s m = m {menuItemSuffix = s}------------------------------------------------------------------------------------- | Change the 'Matcher' function.  The matcher function should--- compare the user's input to the menu items and their assigned--- prefix values and return a 'Choice'.-matcher :: Matcher a -> Menu a -> Menu a-matcher f m = m {menuMatcher = f}------------------------------------------------------------------------------------- | Ask the user to choose an item from a menu.  The menu will only--- be shown once and the user's choice will be returned in a 'Choice'--- value.------ If you want to force the user to only choose from the displayed--- menu items you should use 'askWithMenuRepeatedly' instead.-askWithMenu :: (MonadIO m)-            => Menu a           -- ^ The 'Menu' to display.-            -> Stylized         -- ^ The prompt.-            -> Byline m (Choice a)-askWithMenu m prompt = do-  currCompFunc <- Reader.asks compFunc >>= liftIO . readIORef--  if null (menuItems m)-    then return NoItems-    else go currCompFunc--  where-    -- Use the default completion function for menus, but not if another-    -- completion function is already active.-    go comp = withCompletionFunc (fromMaybe (defaultCompFunc m) comp) $ do-      prefixes <- displayMenu-      answer   <- ask prompt (Just firstItem)-      return (menuMatcher m m prefixes answer)--    -- The default menu item.-    firstItem = Text.strip $ renderText Plain (menuItemPrefix m 1)--    -- Print the entire menu.-    displayMenu = do-      case menuBanner m of-        Nothing -> return ()-        Just br -> sayLn (br <> "\n")--      cache <- foldM listItem Map.empty $ zip  [1..] (menuItems m)--      case menuBeforePrompt m of-        Nothing -> sayLn mempty -- Just for the newline.-        Just bp -> sayLn ("\n" <> bp)--      return cache--    -- Print a menu item and cache its prefix in a Map.-    listItem cache (index, item) = do-      let bullet   = menuItemPrefix m index-          rendered = renderText Plain bullet--      sayLn $ mconcat [ text "  "          -- Indent.-                      , bullet             -- Unique identifier.-                      , menuItemSuffix m   -- Spacer or marker.-                      , menuDisplay m item -- The item.-                      ]--      return (Map.insert (Text.strip rendered) item cache)------------------------------------------------------------------------------------- | Like 'askWithMenu' except that arbitrary input is not allowed.--- If the user doesn't correctly select a menu item then the menu will--- be repeated and an error message will be displayed.-askWithMenuRepeatedly :: (MonadIO m)-           => Menu a            -- ^ The 'Menu' to display.-           -> Stylized          -- ^ The prompt.-           -> Stylized          -- ^ Error message.-           -> Byline m (Choice a)-askWithMenuRepeatedly m prompt errprompt = go m-  where-    go config = do-      answer <- askWithMenu config prompt--      case answer of-        Other _ -> go (config {menuBeforePrompt = Just errprompt})-        _       -> return answer

@@ -1,66 +0,0 @@-{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}-------------------------------------------------------------------------------------- | Modifiers for the @Stylized@ type.-module System.Console.Byline.Modifiers-       ( fg-       , bg-       , bold-       , underline-       , swapFgBg-       ) where------------------------------------------------------------------------------------- Library imports:-import Data.Monoid------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Internal.Color-import System.Console.Byline.Internal.Types-import System.Console.Byline.Stylized------------------------------------------------------------------------------------- The following is a kludge to avoid the "redundant import" warning--- when using GHC >= 7.10.x.  This should be removed after we decide--- to stop supporting GHC < 7.10.x.-import Prelude------------------------------------------------------------------------------------- | Set the foreground color.  For example:------ @---     "Hello World!" <> fg magenta--- @-fg :: Color -> Stylized-fg c = modStylized (mempty {modColorFG = OnlyOne (Just c)})------------------------------------------------------------------------------------- | Set the background color.-bg :: Color -> Stylized-bg c = modStylized (mempty {modColorBG = OnlyOne (Just c)})------------------------------------------------------------------------------------- | Produce bold text.-bold :: Stylized-bold = modStylized (mempty {modBold = On})------------------------------------------------------------------------------------- | Produce underlined text.-underline :: Stylized-underline = modStylized (mempty {modUnderline = On})------------------------------------------------------------------------------------- | Produce swapped foreground/background text.-swapFgBg :: Stylized-swapFgBg = modStylized (mempty {modSwapFgBg = On})

@@ -1,172 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | Primitive operations such as printing messages and reading input.-module System.Console.Byline.Primitive-       ( ReportType (..)-       , say-       , sayLn-       , ask-       , askChar-       , askPassword-       , askUntil-       , report-       , reportLn-       , withCompletionFunc-       ) where------------------------------------------------------------------------------------- Library imports:-import Control.Monad.IO.Class-import qualified Control.Monad.Reader as Reader-import Data.IORef-import Data.Maybe-import Data.Text (Text)-import qualified Data.Text as T-import qualified System.Console.Haskeline as H-------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Color-import System.Console.Byline.Internal.Byline-import System.Console.Byline.Internal.Completion-import System.Console.Byline.Internal.Render-import System.Console.Byline.Modifiers-import System.Console.Byline.Stylized------------------------------------------------------------------------------------- | Report types for the 'report' function.-data ReportType = Error    -- ^ Report errors with: @"error: "@-                | Warning  -- ^ Report warnings with: @"warning: "@------------------------------------------------------------------------------------- | Output the stylized text to the output handle (default: stdout).-say :: (MonadIO m) => Stylized -> Byline m ()-say message = do-  env <- Reader.ask-  liftIO $ render (sayMode env) (outHandle env) message------------------------------------------------------------------------------------- | Like 'say', but append a newline character.-sayLn :: (MonadIO m) => Stylized -> Byline m ()-sayLn message = say (message <> text "\n")------------------------------------------------------------------------------------- | Read input after printing the given stylized text as a prompt.-ask :: (MonadIO m)-    => Stylized-       -- ^ The prompt.--    -> Maybe Text-    -- ^ Optional default answer that will be returned if the user-    -- presses return without providing any input (a zero-length-    -- string).--    -> Byline m Text-ask prompt defans = do-  let prompt' = case defans of-                  Nothing -> prompt-                  Just s  -> prompt <> text "[" <> text s <> "] "--  answer <- liftInputT . H.getInputLine =<< renderPrompt prompt'--  case answer of-    Nothing            -> eof-    Just s | null s    -> return (fromMaybe (T.pack s) defans)-           | otherwise -> return (T.pack s)------------------------------------------------------------------------------------- | Read a single character of input.-askChar :: (MonadIO m)-        => Stylized-        -> Byline m Char-askChar prompt = do-  answer <- liftInputT . H.getInputChar =<< renderPrompt prompt-  case answer of-    Nothing -> eof-    Just c  -> return c------------------------------------------------------------------------------------- | Read a password without echoing it to the terminal.  If a masking--- character is given it will replace each typed character.-askPassword :: (MonadIO m)-            => Stylized-               -- ^ The prompt.--            -> Maybe Char-            -- ^ Optional masking character that will be printed each-            -- time the user presses a key.--            -> Byline m Text-askPassword prompt maskchr = do-  pass <- liftInputT . H.getPassword maskchr =<< renderPrompt prompt-  case pass of-    Nothing -> eof-    Just s  -> return (T.pack s)------------------------------------------------------------------------------------- | Continue to prompt for a response until a confirmation function--- returns a valid result.------ The confirmation function receives the output from 'ask' and should--- return a @Left Stylized@ to produce an error message (printed with--- 'sayLn').  When an acceptable answer from 'ask' is received, the--- confirmation function should return it with @Right@.-askUntil :: (MonadIO m)-         => Stylized                           -- ^ The prompt.-         -> Maybe Text                         -- ^ Optional default answer.-         -> (Text -> m (Either Stylized a))    -- ^ Confirmation function.-         -> Byline m a-askUntil prompt defans confirm = go where-  go = do-    answer <- ask prompt defans-    check  <- liftBase (confirm answer)--    case check of-      Left msg     -> sayLn msg >> go-      Right result -> return result------------------------------------------------------------------------------------- | Output stylized text with a prefix determined by 'ReportType'.-report :: (MonadIO m) => ReportType -> Stylized -> Byline m ()-report Error message   = say $ (text "error: "   <> fg red)    <> message-report Warning message = say $ (text "warning: " <> fg yellow) <> message------------------------------------------------------------------------------------- | Like 'report', but append a newline character.-reportLn :: (MonadIO m) => ReportType -> Stylized -> Byline m ()-reportLn rt message = report rt (message <> text "\n")------------------------------------------------------------------------------------- | Run the given 'Byline' action with a different completion--- function.-withCompletionFunc :: (MonadIO m) => CompletionFunc -> Byline m a -> Byline m a-withCompletionFunc comp byline = do-  compref <- Reader.asks compFunc-  current <- liftIO (readIORef compref)--  -- Temporally change the completion function.-  -- Exceptions will be dealt with in 'runByline'.-  liftIO (writeIORef compref (Just comp))-  output <- byline--  -- Reset the completion function and return the result.-  liftIO (writeIORef compref current)-  return output-----------------------------------------------------------------------------------renderPrompt :: (Monad m) => Stylized -> Byline m String-renderPrompt prompt = do-    mode <- Reader.asks askMode-    return $ T.unpack (renderText mode prompt)

@@ -1,91 +0,0 @@-{---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 git://pmade.com/byline/LICENSE. No part of the-byline package, including this file, may be copied, modified,-propagated, or distributed except according to the terms contained in-the LICENSE file.---}------------------------------------------------------------------------------------- | The stylized type and constructors.-module System.Console.Byline.Stylized-       ( Stylized-       , Modifier-       , text-       , mapStylized-       , modStylized-       ) where------------------------------------------------------------------------------------- Library imports:-import qualified Data.Semigroup as Semi-import Data.String-import Data.Text (Text)-import qualified Data.Text as T------------------------------------------------------------------------------------- Byline imports:-import System.Console.Byline.Internal.Types------------------------------------------------------------------------------------- | Stylized text.  Construct text with modifiers using string--- literals and the @OverloadedStrings@ extension and/or the 'text'--- function.-data Stylized = StylizedText Text Modifier-              | StylizedMod Modifier-              | StylizedList [Stylized]------------------------------------------------------------------------------------- | Helper function to create stylized text.  If you enable the--- @OverloadedStrings@ extension then you can create stylized text--- directly without using this function.------ This function is also helpful for producing stylized text from an--- existing @Text@ value.-text :: Text -> Stylized-text t = StylizedText t mempty------------------------------------------------------------------------------------- | Map a function over stylized text.  The 'Modifier' type is--- opaque so this function might not be very useful outside of the--- Byline internals.-mapStylized :: ((Text, Modifier) -> a) -> Stylized -> [a]-mapStylized f (StylizedText t m) = [ f (t, m) ]-mapStylized _ (StylizedMod    _) = [ ] -- No op.-mapStylized f (StylizedList   l) = concatMap (mapStylized f) l------------------------------------------------------------------------------------- | Constructor to modify stylized text.  This function is only--- useful to internal Byline functions.-modStylized :: Modifier -> Stylized-modStylized = StylizedMod-----------------------------------------------------------------------------------instance Semi.Semigroup Stylized where-  -- StylizedText on LHS.-  (<>) a@(StylizedText _ _) b@(StylizedText _ _) = StylizedList [a, b]-  (<>) (StylizedText t m) (StylizedMod m')       = StylizedText t (m <> m')-  (<>) a@(StylizedText _ _) (StylizedList b)     = StylizedList (a:b)--  -- StylizedMod on LHS.-  (<>) (StylizedMod m) (StylizedText t m') = StylizedText t (m <> m')-  (<>) (StylizedMod m) (StylizedMod m')    = StylizedMod (m <> m')-  (<>) m@(StylizedMod _) (StylizedList l)  = StylizedList (map (m <>) l)--  -- StylizedList on LHS.-  (<>) (StylizedList l) t@(StylizedText _ _) = StylizedList (l <> [t])-  (<>) (StylizedList l) m@(StylizedMod _)    = StylizedList (map (<> m) l)-  (<>) (StylizedList l) (StylizedList l')    = StylizedList (l <> l')------------------------------------------------------------------------------------instance Monoid Stylized where-  mempty = StylizedText mempty mempty-  mappend = (Semi.<>)-----------------------------------------------------------------------------------instance IsString Stylized where-  fromString = text . T.pack

@@ -0,0 +1,60 @@+-- |+--+-- 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.Simulation+import Test.Tasty+import Test.Tasty.HUnit++example :: MonadByline m => m Text+example = do+  sayLn ("Hey, I like " <> ("Haskell" <> fg magenta) <> "!")++  let question =+        "What's "+          <> ("your" <> bold)+          <> " favorite "+          <> ("language" <> fg green <> underline)+          <> "? "++  askLn question (Just "Haskell")++main :: IO ()+main = defaultMain $ do+  testGroup+    "Byline"+    [ testCase "default input" $+        run "" example @?= Just "Haskell",+      testCase "user input" $+        run "Python" example @?= Just "Python",+      testCase "changing state" $ do+        runIdentity (runBylineT textThenDefault example) @?= Just "Current"+        runIdentity (runBylineT textThenDefault (example >> example)) @?= Just "Next"+    ]+  where+    run :: Text -> BylineT Identity Text -> Maybe Text+    run input action =+      let sim = pure (SimulatedInput input)+       in runBylineT sim action & runIdentity+    textThenDefault :: Monad m => SimulationFunction m+    textThenDefault = do+      -- The next input request will come from this function:+      modify (\s -> s {simulationFunction = pure (SimulatedInput "Next")})++      -- But this time we'll return different text:+      pure (SimulatedInput "Current")