Browse Source

Use TERMINFO, separate modes into sayMode and askMode

tags/v0.2.2.0
Peter J. Jones 4 years ago
parent
commit
f222cced6d
5 changed files with 45 additions and 22 deletions
  1. 6
    3
      TODO
  2. 1
    0
      byline.cabal
  3. 1
    0
      default.nix
  4. 35
    17
      src/System/Console/Byline/Internal/Byline.hs
  5. 2
    2
      src/System/Console/Byline/Primary.hs

+ 6
- 3
TODO View File

@@ -2,11 +2,14 @@
#+title: To-Do List

* Before First Release
** TODO When rendering colors directly via `ask`, don't use color codes on Windows
** TODO Use TERMINFO to figure out if we can use rgb colors
** TODO Downgrade full rgb colors to the default terminal colors
** TODO Restore exception safety in `runByline` and `withCompletionFunc`
- 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

+ 1
- 0
byline.cabal View File

@@ -66,6 +66,7 @@ library
, containers >= 0.5 && < 0.6
, 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


+ 1
- 0
default.nix View File

@@ -12,6 +12,7 @@ let
colour
haskeline
mtl
terminfo-hs
text
transformers
]);

+ 35
- 17
src/System/Console/Byline/Internal/Byline.hs View File

@@ -29,7 +29,10 @@ import Control.Monad.Trans.Maybe
import Data.IORef
import System.Console.Byline.Internal.Completion
import System.Console.Byline.Internal.Render
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.
@@ -38,10 +41,11 @@ import qualified System.Console.Haskeline.IO as H

--------------------------------------------------------------------------------
data Env = Env
{ renderMode :: RenderMode
, outHandle :: Handle
, inputState :: H.InputState
, compFunc :: IORef (Maybe CompletionFunc)
{ sayMode :: RenderMode
, askMode :: RenderMode
, outHandle :: Handle
, inputState :: H.InputState
, compFunc :: IORef (Maybe CompletionFunc)
}

--------------------------------------------------------------------------------
@@ -50,21 +54,35 @@ newtype Byline m a = Byline {unByline :: ReaderT Env (MaybeT m) a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env)

--------------------------------------------------------------------------------
defRenderMode :: H.InputT IO RenderMode
defRenderMode :: H.InputT IO (RenderMode, RenderMode)
defRenderMode = do
termHint <- H.haveTerminalUI

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

return mode
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 -> IORef (Maybe CompletionFunc) -> Env
defEnv state mode comp =
Env { renderMode = mode
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
@@ -92,9 +110,9 @@ runByline (Byline byline) = do

let settings = H.setComplete (runCompletionFunction comp) H.defaultSettings
state <- liftIO (H.initializeInput settings)
mode <- liftIO (H.queryInput state defRenderMode)
modes <- liftIO (H.queryInput state defRenderMode)

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

-- FIXME: Use a bracket in here

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

@@ -51,7 +51,7 @@ data ReportType = Error -- ^ Report errors with: @"error: "@
say :: (MonadIO m) => Stylized -> Byline m ()
say message = do
env <- Reader.ask
liftIO $ render (renderMode env) (outHandle env) message
liftIO $ render (sayMode env) (outHandle env) message

--------------------------------------------------------------------------------
-- | Like 'say', but append a newline character.
@@ -151,5 +151,5 @@ withCompletionFunc comp byline = do
--------------------------------------------------------------------------------
renderPrompt :: (Monad m) => Stylized -> Byline m String
renderPrompt prompt = do
mode <- Reader.asks renderMode
mode <- Reader.asks askMode
return $ T.unpack (renderText mode prompt)

Loading…
Cancel
Save