Browse Source

Restore setting comp functions, abort on EOF (remove Maybe everywhere)

tags/v0.2.2.0
Peter J. Jones 4 years ago
parent
commit
37bfc6104a

+ 5
- 3
TODO View File

@@ -8,9 +8,11 @@
** TODO Put the `askUntil` confirmation function into the `Byline m a` monad
** TODO Use TERMINFO to figure out if we can use rgb colors
** TODO Downgrade full rgb colors to the default terminal colors
** TODO Restore the ability to change the completion function
** TODO Restore exception safety in runByline
** TODO Restore exception safety in `runByline` and `withCompletionFunc`
- I'm not using `runInputT` anymore so we don't get MonadException either
** TODO Simplify the interface by aborting on EOF
** 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]

+ 1
- 0
byline.cabal View File

@@ -44,6 +44,7 @@ library
System.Console.Byline
System.Console.Byline.Internal.Byline
System.Console.Byline.Internal.Color
System.Console.Byline.Internal.Completion
System.Console.Byline.Internal.Modifiers
System.Console.Byline.Internal.Render
System.Console.Byline.Internal.Stylized

+ 11
- 18
examples/simple.hs View File

@@ -15,13 +15,14 @@ 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 = runByline $ do
main = void $ runByline $ do

-- Simple message to stdout:
sayLn "Okay, let's kick this off"
@@ -33,28 +34,20 @@ main = runByline $ do
let question = "What's your favorite " <> ("language" <> bold) <> "? "
language <- ask question Nothing

case language of
Nothing -> sayLn "Cat got your tongue?"
Just s -> sayLn ("I see, you like " <> text s <> ".")
if Text.null language
then sayLn "Cat got your tongue?"
else sayLn ("I see, you like " <> text language <> ".")

-- Keep prompting until a confirmation function indicates that the
-- user's input is sufficient:
name <- askUntil "What's your name? " Nothing atLeastThreeChars

case name of
Nothing -> sayLn "You must have sent an EOF"
Just s -> sayLn ("Hey there " <> text s)
sayLn ("Hey there " <> text name)

--------------------------------------------------------------------------------
-- | Example confirmation function that requires the input to be three
-- or more characters long.
atLeastThreeChars :: Maybe Text -> Either Stylized Text
atLeastThreeChars input = case input of
Nothing -> Left msg
Just s
| Text.length s < 3 -> Left "You can do better."
| otherwise -> Right s

where
msg = "Hey, you have to enter something, " <>
("please" <> fg green <> underline) <> "."
atLeastThreeChars :: Text -> Either Stylized Text
atLeastThreeChars input =
if Text.length input < 3
then Left "You can do better."
else Right input

+ 6
- 1
src/System/Console/Byline.hs View File

@@ -46,10 +46,14 @@ module System.Console.Byline
, Byline
, runByline

-- * Completion
, CompletionFunc
, Completion
, withCompletionFunc

-- * Utility Functions, Operators, and Types
, Stylized
, ReportType (..)
, withCompletionFunc
, (<>)
) where

@@ -59,6 +63,7 @@ import Data.Monoid ((<>))
--------------------------------------------------------------------------------
import System.Console.Byline.Internal.Byline
import System.Console.Byline.Internal.Color
import System.Console.Byline.Internal.Completion
import System.Console.Byline.Internal.Modifiers
import System.Console.Byline.Internal.Stylized
import System.Console.Byline.Menu

+ 38
- 28
src/System/Console/Byline/Internal/Byline.hs View File

@@ -15,6 +15,7 @@ the LICENSE file.
module System.Console.Byline.Internal.Byline
( Byline (..)
, Env (..)
, eof
, liftInputT
, runByline
) where
@@ -23,6 +24,9 @@ module System.Console.Byline.Internal.Byline
--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.IORef
import System.Console.Byline.Internal.Completion
import System.Console.Byline.Internal.Render
import System.IO (Handle, stdout)

@@ -33,55 +37,60 @@ import qualified System.Console.Haskeline.IO as H

--------------------------------------------------------------------------------
data Env = Env
{ renderMode :: RenderMode
, outHandle :: Handle
, inputState :: H.InputState
, hlSettings :: H.Settings IO
, otherCompFunc :: Maybe (H.CompletionFunc IO)
{ renderMode :: RenderMode
, outHandle :: Handle
, inputState :: H.InputState
, compFunc :: IORef (Maybe CompletionFunc)
}

--------------------------------------------------------------------------------
-- | Reader environment for Byline.
newtype Byline m a = Byline {unByline :: ReaderT Env m a}
newtype Byline m a = Byline {unByline :: ReaderT Env (MaybeT m) a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env)

--------------------------------------------------------------------------------
defEnv :: H.InputState -> H.Settings IO -> H.InputT IO Env
defEnv state settings = do
defRenderMode :: H.InputT IO RenderMode
defRenderMode = do
termHint <- H.haveTerminalUI

let mode = case termHint of -- FIXME: consider TERM and TERMINFO
False -> Plain
True -> Simple

return Env { renderMode = mode
, outHandle = stdout
, hlSettings = settings
, inputState = state
, otherCompFunc = Nothing
}
return mode

--------------------------------------------------------------------------------
-- | Create the default reader environment.
defEnv :: H.InputState -> RenderMode -> IORef (Maybe CompletionFunc) -> Env
defEnv state mode comp =
Env { renderMode = mode
, outHandle = stdout
, inputState = state
, compFunc = comp
}

--------------------------------------------------------------------------------
eof :: (Monad m) => Byline m a
eof = Byline $ lift (MaybeT $ return Nothing)

--------------------------------------------------------------------------------
-- | Lift an 'InputT' action into 'Byline'.
liftInputT :: (MonadIO m) => H.InputT IO a -> Byline m a
liftInputT input = do
env <- ask

-- let settings = case otherCompFunc env of
-- Nothing -> hlSettings env
-- Just f -> setComplete f (hlSettings env)

-- Byline $ lift (runInputT settings input)

liftIO (H.queryInput (inputState env) $ H.withInterrupt input)
state <- asks inputState
liftIO (H.queryInput state $ H.withInterrupt input)

--------------------------------------------------------------------------------
runByline :: (MonadIO m) => Byline m a -> m a
runByline byline = do
let settings = H.defaultSettings
runByline :: (MonadIO m) => Byline m a -> m (Maybe a)
runByline (Byline byline) = do
comp <- liftIO (newIORef Nothing)

let settings = H.setComplete (runCompletionFunction comp) H.defaultSettings
state <- liftIO (H.initializeInput settings)
env <- liftIO (H.queryInput state $ defEnv state settings)
output <- runReaderT (unByline byline) env
mode <- liftIO (H.queryInput state defRenderMode)

output <- runMaybeT $ runReaderT byline (defEnv state mode comp)
liftIO (H.closeInput state)

-- FIXME: Use a bracket in here
return output

+ 51
- 0
src/System/Console/Byline/Internal/Completion.hs View File

@@ -0,0 +1,51 @@
{-

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.Internal.Completion
( CompletionFunc
, Completion (..)
, runCompletionFunction
) where

--------------------------------------------------------------------------------
import Data.IORef
import Data.Text (Text)
import qualified Data.Text as Text
import qualified System.Console.Haskeline.Completion as H

--------------------------------------------------------------------------------
data Completion = Completion
{ replacement :: Text
, display :: Text
, isFinished :: Bool
} deriving (Eq, Ord, Show)

--------------------------------------------------------------------------------
type CompletionFunc = (Text, Text) -> IO (Text, [Completion])

--------------------------------------------------------------------------------
convertCompletion :: Completion -> H.Completion
convertCompletion (Completion r d i) =
H.Completion { H.replacement = Text.unpack r
, H.display = Text.unpack d
, H.isFinished = i
}

--------------------------------------------------------------------------------
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.pack left, Text.pack right)
return (Text.unpack output, map convertCompletion completions)

+ 14
- 17
src/System/Console/Byline/Menu.hs View File

@@ -30,17 +30,18 @@ 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 T
import qualified Data.Text as Text
import System.Console.Byline.Internal.Byline
import System.Console.Byline.Internal.Completion
import System.Console.Byline.Internal.Render
import System.Console.Byline.Internal.Stylized
import System.Console.Byline.Primary
import System.Console.Haskeline
import Text.Printf (printf)

--------------------------------------------------------------------------------
@@ -60,7 +61,6 @@ data Menu a = Menu
-- a menu.
data Choice a = Match a -- ^ User picked a menu item.
| Other Text -- ^ User entered some text.
| Empty -- ^ Ctrl-d or EOF encountered.
deriving Show

--------------------------------------------------------------------------------
@@ -74,7 +74,7 @@ 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 . T.pack . printf "%2d"
numbered = text . Text.pack . printf "%2d"

--------------------------------------------------------------------------------
-- | Helper function to produce a list of menu items matching the
@@ -83,7 +83,7 @@ matchOnPrefix :: Menu a -> Text -> [a]
matchOnPrefix config input = filter prefixCheck (menuItems config)
where
asText i = renderText Plain (menuDisplay config i)
prefixCheck i = input `T.isPrefixOf` asText i
prefixCheck i = input `Text.isPrefixOf` asText i

--------------------------------------------------------------------------------
-- | Default 'Matcher' function. Checks to see if the user has input
@@ -105,19 +105,19 @@ defaultMatcher config prefixes input =

--------------------------------------------------------------------------------
-- | Default completion function. Matches all of the menu items.
defaultCompFunc :: (Monad m) => Menu a -> CompletionFunc m
defaultCompFunc :: Menu a -> CompletionFunc
defaultCompFunc config (left, _) = return ("", completions matches)
where
-- All matching menu items.
matches = if null left
matches = if Text.null left
then menuItems config
else matchOnPrefix config (T.pack $ reverse left)
else matchOnPrefix config (Text.reverse left)

-- Convert a menu item to a String.
asString i = T.unpack $ renderText Plain (menuDisplay config i)
asText i = renderText Plain (menuDisplay config i)

-- Convert menu items into Completion values.
completions = map (\i -> Completion (asString i) (asString i) False)
completions = map (\i -> Completion (asText i) (asText i) False)

--------------------------------------------------------------------------------
-- | Create a 'Menu' by giving a list of menu items and a function
@@ -173,17 +173,15 @@ askWithMenu :: (MonadIO m)
-> Stylized -- ^ The prompt.
-> Byline m (Choice a)
askWithMenu m prompt = do
currCompFunc <- Reader.asks otherCompFunc
currCompFunc <- Reader.asks compFunc >>= liftIO . readIORef


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

case answer of
Nothing -> return Empty
Just input -> return (menuMatcher m m prefixes input)
return (menuMatcher m m prefixes answer)

where
-- Print the entire menu.
@@ -211,7 +209,7 @@ askWithMenu m prompt = do
, menuDisplay m item -- The item.
]

return (Map.insert (T.strip rendered) item cache)
return (Map.insert (Text.strip rendered) item cache)

--------------------------------------------------------------------------------
-- | Like 'askWithMenu' except that arbitrary input is not allowed.
@@ -229,5 +227,4 @@ askWithMenuRepeatedly m prompt errprompt = go m

case answer of
Match _ -> return answer
Empty -> return Empty
_ -> go (config {menuBeforePrompt = Just errprompt})

+ 36
- 25
src/System/Console/Byline/Primary.hs View File

@@ -26,18 +26,20 @@ module System.Console.Byline.Primary
) where

--------------------------------------------------------------------------------
import Control.Applicative
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 System.Console.Byline.Internal.Byline
import System.Console.Byline.Internal.Color
import System.Console.Byline.Internal.Completion
import System.Console.Byline.Internal.Modifiers
import System.Console.Byline.Internal.Render
import System.Console.Byline.Internal.Stylized
import System.Console.Haskeline
import qualified System.Console.Haskeline as H

--------------------------------------------------------------------------------
-- | Report types for the 'report' function.
@@ -61,26 +63,30 @@ sayLn message = say (message <> text "\n")
ask :: (MonadIO m)
=> Stylized -- ^ The prompt.
-> Maybe Text -- ^ Optional default answer.
-> Byline m (Maybe Text)
-> Byline m Text
ask prompt defans = do
let prompt' = case defans of
Nothing -> prompt
Just s -> prompt <> text "[" <> text s <> "] "

answer <- liftInputT . getInputLine =<< renderPrompt prompt'
answer <- liftInputT . H.getInputLine =<< renderPrompt prompt'

return $ case answer of
Nothing -> Nothing
Just s | null s -> defans <|> (T.pack <$> answer)
| otherwise -> T.pack <$> answer
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. Like other functions,
-- 'askChar' will return 'Nothing' if the user issues a Ctrl-d/EOF.
askChar :: (MonadIO m)
=> Stylized
-> Byline m (Maybe Char)
askChar prompt = liftInputT . getInputChar =<< renderPrompt prompt
-> 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
@@ -88,10 +94,12 @@ askChar prompt = liftInputT . getInputChar =<< renderPrompt prompt
askPassword :: (MonadIO m)
=> Stylized -- ^ The prompt.
-> Maybe Char -- ^ Masking character.
-> Byline m (Maybe Text)
-> Byline m Text
askPassword prompt maskchr = do
pass <- liftInputT . getPassword maskchr =<< renderPrompt prompt
return (T.pack <$> pass)
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
@@ -102,16 +110,16 @@ askPassword prompt maskchr = do
-- '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.
-> (Maybe Text -> Either Stylized Text) -- ^ Confirmation function.
-> Byline m (Maybe Text)
=> Stylized -- ^ The prompt.
-> Maybe Text -- ^ Optional default answer.
-> (Text -> Either Stylized Text) -- ^ Confirmation function.
-> Byline m Text
askUntil prompt defans confirm = go where
go = do
answer <- ask prompt defans
case confirm answer of
Left msg -> sayLn msg >> go
Right result -> return (Just result)
Right result -> return result

--------------------------------------------------------------------------------
-- | Output stylized text with a prefix determined by 'ReportType'.
@@ -127,13 +135,16 @@ reportLn rt message = report rt (message <> text "\n")
--------------------------------------------------------------------------------
-- | Run the given 'Byline' action with a different completion
-- function.
withCompletionFunc :: (Monad m) => CompletionFunc IO -> Byline m a -> Byline m a
withCompletionFunc comp byline =
Byline $ Reader.local updateComp (unByline byline)

where
-- updateComp :: Env m -> Env m
updateComp env = env { otherCompFunc = Just comp }
withCompletionFunc :: (MonadIO m) => CompletionFunc -> Byline m a -> Byline m a
withCompletionFunc comp byline = do
compref <- Reader.asks compFunc
current <- liftIO (readIORef compref)

-- FIXME: Use a bracket in here.
liftIO (writeIORef compref (Just comp))
output <- byline
liftIO (writeIORef compref current)
return output

--------------------------------------------------------------------------------
renderPrompt :: (Monad m) => Stylized -> Byline m String

Loading…
Cancel
Save