packages feed

byline (empty) → 0.1.0.0

raw patch · 19 files changed

+1578/−0 lines, 19 filesdep +ansi-terminaldep +basedep +bylinesetup-changed

Dependencies added: ansi-terminal, base, byline, colour, containers, exceptions, haskeline, mtl, terminfo-hs, text, transformers

Files

+ CHANGES view
@@ -0,0 +1,8 @@+-*- org -*-++#+title: Version History+#+startup: showall++* 0.1.0.0 (May 19, 2015)++  - Initial release.
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2015, 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.
+ README.md view
@@ -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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ byline.cabal view
@@ -0,0 +1,111 @@+--------------------------------------------------------------------------------+name:          byline+version:       0.1.0.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 Peter J. Jones+category:      System+build-type:    Simple+stability:     experimental+tested-with:   GHC == 7.8.4+cabal-version: >=1.10+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+  ghc-prof-options: -prof -auto-all++  if flag(maintainer)+    ghc-options: -Werror++  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.2+               , terminfo-hs   >= 0.1  && < 0.2+               , text          >= 0.11 && < 1.3+               , transformers  >= 0.3  && < 0.4++--------------------------------------------------------------------------------+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
+ examples/menu.hs view
@@ -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)
+ examples/simple.hs view
@@ -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
+ src/System/Console/Byline.hs view
@@ -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
+ src/System/Console/Byline/Color.hs view
@@ -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)
+ src/System/Console/Byline/Completion.hs view
@@ -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)
+ src/System/Console/Byline/Internal/Byline.hs view
@@ -0,0 +1,144 @@+{-# 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++--------------------------------------------------------------------------------+-- | 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
+ src/System/Console/Byline/Internal/Color.hs view
@@ -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)
+ src/System/Console/Byline/Internal/Completion.hs view
@@ -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)
+ src/System/Console/Byline/Internal/Render.hs view
@@ -0,0 +1,142 @@+{-# 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++--------------------------------------------------------------------------------+-- | 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)
+ src/System/Console/Byline/Internal/Types.hs view
@@ -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')
+ src/System/Console/Byline/Menu.hs view
@@ -0,0 +1,243 @@+{-# 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 = 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+  let firstItem = Text.strip $ renderText Plain (menuItemPrefix m 1)++  -- Use the default completion function for menus, but not if another+  -- completion function is already active.+  withCompletionFunc (fromMaybe (defaultCompFunc m) currCompFunc) $ do+    prefixes <- displayMenu+    answer   <- ask prompt (Just firstItem)+    return (menuMatcher m m prefixes answer)++  where+    -- 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+        Match _ -> return answer+        _       -> go (config {menuBeforePrompt = Just errprompt})
+ src/System/Console/Byline/Modifiers.hs view
@@ -0,0 +1,54 @@+{-++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++--------------------------------------------------------------------------------+-- | 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})
+ src/System/Console/Byline/Primitive.hs view
@@ -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)
+ src/System/Console/Byline/Stylized.hs view
@@ -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