Browse Source

Add 'vendor/byline/' from commit '33e9e0945c1bacf0c9329949c567e28192fa515a'

git-subtree-dir: vendor/byline
git-subtree-mainline: 18d8307405
git-subtree-split: 33e9e0945c
tags/v0.2.2.0
Peter J. Jones 3 years ago
parent
commit
38ce8d2e60

+ 2
- 0
vendor/byline/.gitignore View File

@@ -0,0 +1,2 @@
/.stack-work
/build/.stack-work

+ 0
- 0
vendor/byline/.gitmodules View File


+ 18
- 0
vendor/byline/CHANGES View File

@@ -0,0 +1,18 @@
-*- org -*-

#+title: Version History
#+startup: showall

* 0.2.1.0 (November 5, 2014)

- Updated dependencies

* 0.2.0.0 (May 22, 2015)

- Added the NoItems constructor for Choice to deal with menus that
are asked to display an empty list.
- Changes to build with GHC 7.8.4. and 7.10.1

* 0.1.0.0 (May 19, 2015)

- Initial release.

+ 26
- 0
vendor/byline/LICENSE View File

@@ -0,0 +1,26 @@
Copyright (c) 2015,2016, Peter J. Jones <pjones@devalot.com>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the
distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ 21
- 0
vendor/byline/README.md View File

@@ -0,0 +1,21 @@
# Byline

Byline simplifies writing interactive terminal 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.

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.

## Examples

Please see the example programs in the `examples` directory.

[ansi-terminal]: http://hackage.haskell.org/package/ansi-terminal
[haskeline]: https://hackage.haskell.org/package/haskeline
[highline]: https://github.com/JEG2/highline
[terminal library]: https://github.com/cdxr/terminal

+ 2
- 0
vendor/byline/Setup.hs View File

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

+ 25
- 0
vendor/byline/TODO View File

@@ -0,0 +1,25 @@
-*- org -*-
#+title: To-Do List

* Before First Release
** DONE Restore exception safety in `runByline` and `withCompletionFunc`
CLOSED: [2015-05-18 Mon 19:55]
- I'm not using `runInputT` anymore so we don't get MonadException either
** DONE When rendering colors directly via `ask`, don't use color codes on Windows
CLOSED: [2015-05-18 Mon 18:02]
** DONE Use TERMINFO to figure out if we can use rgb colors
CLOSED: [2015-05-18 Mon 18:02]
** DONE Downgrade full rgb colors to the default terminal colors
CLOSED: [2015-05-18 Mon 18:02]
** DONE Don't loop (in `askUntil`) if running in non-interactive (file) mode
CLOSED: [2015-05-14 Thu 17:00]
** DONE `askWithMenuRepeatedly` should do the right thing if reading from a file
CLOSED: [2015-05-14 Thu 17:01]
** DONE Put the `askUntil` confirmation function into the `Byline m a` monad
CLOSED: [2015-05-14 Thu 17:11]
** DONE Restore the ability to change the completion function
CLOSED: [2015-05-14 Thu 15:23]
** DONE Simplify the interface by aborting on EOF
CLOSED: [2015-05-14 Thu 16:27]
** DONE Remove `MonadException` from the interface
CLOSED: [2015-05-13 Wed 14:39]

+ 10
- 0
vendor/byline/build/nixpkgs.nix View File

@@ -0,0 +1,10 @@
with (import <nixpkgs> {});

stdenv.mkDerivation {
name = "byline";

buildInputs = [
haskell.packages.lts-4_2.ghc
ncurses
];
}

+ 12
- 0
vendor/byline/build/stack.yaml View File

@@ -0,0 +1,12 @@
flags:
byline:
maintainer: true
build-examples: true

packages:
- ../

extra-deps:
- terminfo-hs-0.2.1

resolver: lts-4.2

+ 111
- 0
vendor/byline/byline.cabal View File

@@ -0,0 +1,111 @@
--------------------------------------------------------------------------------
name: byline
version: 0.2.1.0
synopsis: Library for creating command-line interfaces (colors, menus, etc.)
homepage: http://github.com/pjones/byline
bug-reports: http://github.com/pjones/byline/issues
license: BSD2
license-file: LICENSE
author: Peter Jones <pjones@devalot.com>
maintainer: Peter Jones <pjones@devalot.com>
copyright: Copyright: (c) 2015,2016 Peter J. Jones
category: System, User Interfaces
build-type: Simple
stability: experimental
tested-with: GHC == 7.8.4, GHC == 7.10.3
cabal-version: >=1.18
description:
Byline simplifies writing interactive terminal 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.
.
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.

--------------------------------------------------------------------------------
extra-source-files:
CHANGES
README.md
examples/*.hs

--------------------------------------------------------------------------------
source-repository head
type: git
location: git://github.com/pjones/byline.git

--------------------------------------------------------------------------------
flag maintainer
description: Enable settings for the package maintainer.
manual: True
default: False

--------------------------------------------------------------------------------
flag build-examples
description: Build examples when building the library.
manual: True
default: False

--------------------------------------------------------------------------------
library
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

hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall -fwarn-incomplete-uni-patterns

if flag(maintainer)
ghc-options: -Werror
ghc-prof-options: -prof -auto-all

build-depends: base >= 4.7 && < 5.0
, ansi-terminal >= 0.6 && < 0.7
, colour >= 2.3 && < 2.4
, containers >= 0.5 && < 0.6
, exceptions >= 0.8 && < 0.9
, 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.5

--------------------------------------------------------------------------------
executable simple
main-is: examples/simple.hs
default-language: Haskell2010
ghc-options: -Wall -fwarn-incomplete-uni-patterns
build-depends: base, byline, text

if flag(maintainer)
ghc-options: -Werror

if !flag(build-examples)
buildable: False

--------------------------------------------------------------------------------
executable menu
main-is: examples/menu.hs
default-language: Haskell2010
ghc-options: -Wall -fwarn-incomplete-uni-patterns
build-depends: base, byline, text

if flag(maintainer)
ghc-options: -Werror

if !flag(build-examples)
buildable: False

+ 45
- 0
vendor/byline/examples/menu.hs View File

@@ -0,0 +1,45 @@
{-# 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

--------------------------------------------------------------------------------
import Data.Text (Text)
import System.Console.Byline

--------------------------------------------------------------------------------
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)

--------------------------------------------------------------------------------
items :: [Item]
items = [ Fruit "Watermelon"
, Vegetable "Cucumber"
, Fruit "Kiwi"
, Vegetable "Asparagus"
]

--------------------------------------------------------------------------------
main :: IO ()
main = do
let menuConfig = banner "Pick a snack: " $ menu items displayItem
prompt = "Which snack? "
onError = "please pick a valid item!" <> fg red

answer <- runByline $ askWithMenuRepeatedly menuConfig prompt onError
putStrLn ("you picked: " ++ show answer)

+ 53
- 0
vendor/byline/examples/simple.hs View File

@@ -0,0 +1,53 @@
{-# 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

--------------------------------------------------------------------------------
import Control.Monad (void)
import Data.Text (Text)
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!")

-- Get user input with a stylized prompt:
let question = "What's your favorite " <> ("language" <> bold) <> "? "
language <- ask question Nothing

if Text.null language
then sayLn "Cat got your tongue?"
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
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

+ 122
- 0
vendor/byline/src/System/Console/Byline.hs View File

@@ -0,0 +1,122 @@
{-

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

-- * 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 Data.Monoid ((<>))

--------------------------------------------------------------------------------
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

+ 69
- 0
vendor/byline/src/System/Console/Byline/Color.hs View File

@@ -0,0 +1,69 @@
{-

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)

+ 57
- 0
vendor/byline/src/System/Console/Byline/Completion.hs View File

@@ -0,0 +1,57 @@
{-

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)

+ 150
- 0
vendor/byline/src/System/Console/Byline/Internal/Byline.hs View File

@@ -0,0 +1,150 @@
{-# 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)

--------------------------------------------------------------------------------
-- | 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

+ 101
- 0
vendor/byline/src/System/Console/Byline/Internal/Color.hs View File

@@ -0,0 +1,101 @@
{-# 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)

+ 55
- 0
vendor/byline/src/System/Console/Byline/Internal/Completion.hs View File

@@ -0,0 +1,55 @@
{-# 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)

+ 148
- 0
vendor/byline/src/System/Console/Byline/Internal/Render.hs View File

@@ -0,0 +1,148 @@
{-# 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
]

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

--------------------------------------------------------------------------------
-- | 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)

+ 65
- 0
vendor/byline/src/System/Console/Byline/Internal/Types.hs View File

@@ -0,0 +1,65 @@
{-# 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 Data.Monoid

--------------------------------------------------------------------------------
-- Byline imports:
import System.Console.Byline.Color (Color)

--------------------------------------------------------------------------------
-- | Like @Bool@, but with a different @Monoid@ instance.
data Status = On | Off

--------------------------------------------------------------------------------
instance Monoid Status where
mempty = Off
mappend Off Off = Off
mappend Off On = On
mappend On On = On
mappend On Off = On

--------------------------------------------------------------------------------
-- | Like @Maybe@, but with a different @Monoid@ instance.
newtype OnlyOne a = OnlyOne {unOne :: Maybe a}

--------------------------------------------------------------------------------
instance Monoid (OnlyOne a) where
mempty = OnlyOne Nothing
mappend _ b@(OnlyOne (Just _)) = b
mappend a _ = a

--------------------------------------------------------------------------------
-- | Information about modifications made to stylized text.
data Modifier = Modifier
{ modColorFG :: OnlyOne Color
, modColorBG :: OnlyOne Color
, modBold :: Status
, modUnderline :: Status
}

--------------------------------------------------------------------------------
instance Monoid Modifier where
mempty = Modifier mempty mempty mempty mempty
mappend (Modifier a b c d) (Modifier a' b' c' d') =
Modifier (a <> a') (b <> b') (c <> c') (d <> d')

+ 250
- 0
vendor/byline/src/System/Console/Byline/Menu.hs View File

@@ -0,0 +1,250 @@
{-# 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.Monoid
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

+ 60
- 0
vendor/byline/src/System/Console/Byline/Modifiers.hs View File

@@ -0,0 +1,60 @@
{-

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
) 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})

+ 173
- 0
vendor/byline/src/System/Console/Byline/Primitive.hs View File

@@ -0,0 +1,173 @@
{-# 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.Monoid
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 Text)) -- ^ Confirmation function.
-> Byline m Text
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)

+ 87
- 0
vendor/byline/src/System/Console/Byline/Stylized.hs View File

@@ -0,0 +1,87 @@
{-

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 Data.Monoid
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 Monoid Stylized where
mempty = StylizedText mempty mempty

-- StylizedText on LHS.
mappend a@(StylizedText _ _) b@(StylizedText _ _) = StylizedList [a, b]
mappend (StylizedText t m) (StylizedMod m') = StylizedText t (m <> m')
mappend a@(StylizedText _ _) (StylizedList b) = StylizedList (a:b)

-- StylizedMod on LHS.
mappend (StylizedMod m) (StylizedText t m') = StylizedText t (m <> m')
mappend (StylizedMod m) (StylizedMod m') = StylizedMod (m <> m')
mappend m@(StylizedMod _) (StylizedList l) = StylizedList (map (m <>) l)

-- StylizedList on LHS.
mappend (StylizedList l) t@(StylizedText _ _) = StylizedList (l <> [t])
mappend (StylizedList l) m@(StylizedMod _) = StylizedList (map (<> m) l)
mappend (StylizedList l) (StylizedList l') = StylizedList (l <> l')

--------------------------------------------------------------------------------
instance IsString Stylized where
fromString = text . T.pack

Loading…
Cancel
Save