Browse Source

High-level building blocks

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

+ 0
- 3
.gitmodules View File

@@ -1,3 +0,0 @@
[submodule "util"]
path = util
url = git://pmade.com/haskell-util.git

+ 0
- 16
GNUmakefile View File

@@ -1,16 +0,0 @@
################################################################################
.PHONEY: all install restart

################################################################################
# Set up the default target.
all::

################################################################################
# Ask `git' to update the submodule and make haskell.mk available.
util/haskell.mk:
git submodule update --init

################################################################################
# From util/haskell.mk (git submodule update --init)
CABAL_FLAGS = --enable-tests -fmaintainer
include util/haskell.mk

+ 7
- 2
byline.cabal View File

@@ -35,11 +35,14 @@ flag maintainer
--------------------------------------------------------------------------------
library
exposed-modules:
System.Console.Byline
System.Console.Byline.Internal.Byline
System.Console.Byline.Internal.Color
System.Console.Byline.Internal.Modifiers
System.Console.Byline.Internal.Stylized
System.Console.Byline.Internal.Render
System.Console.Byline.Internal.Stylized
System.Console.Byline.Internal.Types
System.Console.Byline.Primary

hs-source-dirs: src
default-language: Haskell2010
@@ -50,6 +53,8 @@ library
ghc-options: -Werror

build-depends: base >= 4.7 && < 5.0
, haskeline >= 0.7 && < 0.8
, ansi-terminal >= 0.6 && < 0.7
, haskeline >= 0.7 && < 0.8
, mtl >= 2.1 && < 2.2
, text >= 0.11 && < 1.3
, transformers >= 0.3 && < 0.4

+ 29
- 25
default.nix View File

@@ -1,32 +1,36 @@
{ pkgs ? (import <nixpkgs> {}) }:
{ stdenv, haskellPackages }:

let haskellPackages = pkgs.haskellPackages; in
let
env = haskellPackages.ghcWithPackages (p: with p; [
# Tools:
cabal-install hlint

haskellPackages.cabal.mkDerivation (self: {
pname = "byline";
version = "0.0.0.0";
src = ./.;
isLibrary = true;
isExecutable = true;
# Libraries:
haskeline ansi-terminal text mtl transformers
]);

buildTools = with pkgs; [
haskellPackages.ghc
haskellPackages.cabalInstall
haskellPackages.hlint
];
in stdenv.mkDerivation rec {
name = "byline";
src = ./src;

buildDepends = with pkgs; [
zlib
];
buildInputs = [ env ];

shellHook = with pkgs; ''
export LD_LIBRARY_PATH="${zlib}/lib:$LD_LIBRARY_PATH"
buildPhase = ''
( HOME="$(mktemp -d)" # For cabal-install.
cabal build || exit 1
cabal test || exit 1
)

hlint src
'';

installPhase = ''
'';

meta = with self.stdenv.lib; {
homepage = http://github.com/pjones/byline;
description = "";
license = licenses.mit;
platforms = self.ghc.meta.platforms;
};
})
shellHook = ''
export NIX_GHC="${env}/bin/ghc"
export NIX_GHCPKG="${env}/bin/ghc-pkg"
export NIX_GHC_DOCDIR="${env}/share/doc/ghc/html"
export NIX_GHC_LIBDIR=$( $NIX_GHC --print-libdir )
'';
}

+ 6
- 0
shell.nix View File

@@ -0,0 +1,6 @@
{ pkgs ? (import <nixpkgs> {}) }:

(import ./default.nix) {
stdenv = pkgs.stdenv;
haskellPackages = pkgs.haskellngPackages;
}

+ 47
- 0
src/System/Console/Byline.hs View File

@@ -0,0 +1,47 @@
{-

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
( -- * Primary Operations
say
, sayLn
, ask
, report
, reportLn
, withCompletionFunc

-- * Constructing Stylized Text
, text

-- * Modifying Output Text
, fg, bg, bold, underline

-- * Specifying Colors
, black, red, green, yellow, blue, magenta, cyan, white, rgb

-- * Executing Terminal IO
, runByline

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

--------------------------------------------------------------------------------
import Data.Monoid ((<>))

--------------------------------------------------------------------------------
import System.Console.Byline.Internal.Byline
import System.Console.Byline.Internal.Modifiers
import System.Console.Byline.Internal.Stylized
import System.Console.Byline.Primary
import System.Console.Byline.Internal.Color

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

@@ -0,0 +1,67 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-

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.Byline
( Byline (..)
, Env (..)
, liftInputT
, runByline
) where


--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.Reader
import System.Console.Byline.Internal.Render
import System.Console.Haskeline
import System.IO (Handle, stdout)

--------------------------------------------------------------------------------
data Env = Env
{ renderMode :: RenderMode
, outHandle :: Handle
, hlSettings :: Settings IO
}

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

--------------------------------------------------------------------------------
defEnv :: (MonadException m) => InputT m Env
defEnv = do
termHint <- haveTerminalUI

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

return $ Env { renderMode = mode
, outHandle = stdout
, hlSettings = defaultSettings
}


--------------------------------------------------------------------------------
liftInputT :: InputT IO a -> Byline a
liftInputT input = do
settings <- asks hlSettings
liftIO $ runInputT settings input

--------------------------------------------------------------------------------
runByline :: (MonadException m) => Byline a -> m a
runByline byline = runInputT defaultSettings $ do
env <- defEnv
withInterrupt . liftIO $ runReaderT (unByline byline) env

+ 36
- 9
src/System/Console/Byline/Internal/Render.hs View File

@@ -9,16 +9,20 @@ the LICENSE file.

-}


--------------------------------------------------------------------------------
-- | FIXME: Holy crap this needs some major refactoring!
module System.Console.Byline.Internal.Render
( RenderMode (..)
, render
, renderText
) where

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad (void)
import Data.Functor.Identity
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import System.Console.ANSI as ANSI
@@ -34,11 +38,11 @@ data RenderMode = Plain -- ^ Text only, no modifiers.

--------------------------------------------------------------------------------
render :: RenderMode -> Handle -> Stylized -> IO ()
render mode h = mapStylized $
render mode h stylized =
case mode of
Plain -> renderPlain
Simple -> renderSimple
Full -> renderFull
Plain -> mapStylized void renderPlain stylized
Simple -> mapStylized void renderSimple stylized
Full -> mapStylized void renderFull stylized

where
renderPlain :: (Text, Modifier) -> IO ()
@@ -53,6 +57,29 @@ render mode h = mapStylized $
renderFull :: (Text, Modifier) -> IO ()
renderFull = undefined

--------------------------------------------------------------------------------
-- | Render into a 'Text' value. Won't work on Windows.
renderText :: RenderMode -> Stylized -> Text
renderText mode stylized = runIdentity $
case mode of
Plain -> mapStylized (fmap mconcat) renderPlain stylized
Simple -> mapStylized (fmap mconcat) renderSimple stylized
Full -> mapStylized (fmap mconcat) renderFull stylized

where
renderPlain :: (Text, Modifier) -> Identity Text
renderPlain = return . fst

renderSimple :: (Text, Modifier) -> Identity Text
renderSimple (t, m) = return $ mconcat
[ T.pack (setSGRCode $ modToSGR m)
, t
, T.pack (setSGRCode [Reset])
]

renderFull :: (Text, Modifier) -> Identity Text
renderFull = undefined

--------------------------------------------------------------------------------
modToSGR :: Modifier -> [SGR]
modToSGR m =
@@ -77,7 +104,7 @@ modToSGR m =
On -> Just SingleUnderline

--------------------------------------------------------------------------------
mapStylized :: ((Text, Modifier) -> IO ()) -> Stylized -> IO ()
mapStylized f (StylizedText t m) = f (t, m)
mapStylized f (StylizedMod m) = f (T.empty, m)
mapStylized f (StylizedList l) = sequence_ $ map (mapStylized f) l
mapStylized :: (Monad m) => (m [a] -> m a) -> ((Text, Modifier) -> m a) -> Stylized -> m a
mapStylized _ g (StylizedText t m) = g (t, m)
mapStylized _ g (StylizedMod m) = g (T.empty, m)
mapStylized f g (StylizedList l) = f (sequence $ map (mapStylized f g) l)

+ 9
- 0
src/System/Console/Byline/Internal/Stylized.hs View File

@@ -19,7 +19,9 @@ module System.Console.Byline.Internal.Stylized

--------------------------------------------------------------------------------
import Data.Monoid
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import System.Console.Byline.Internal.Color
import System.Console.Byline.Internal.Types

@@ -37,6 +39,9 @@ data Stylized = StylizedText Text 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.
text :: Text -> Stylized
text t = StylizedText t mempty

@@ -64,3 +69,7 @@ instance Monoid Stylized where
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

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

@@ -0,0 +1,84 @@
{-# 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 System.Console.Byline.Primary
( ReportType (..)
, say
, sayLn
, ask
, report
, reportLn
, withCompletionFunc
) where

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.IO.Class
import qualified Control.Monad.Reader as Reader
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.Modifiers
import System.Console.Byline.Internal.Render
import System.Console.Byline.Internal.Stylized
import System.Console.Haskeline

--------------------------------------------------------------------------------
-- | 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 :: Stylized -> Byline ()
say message = do
env <- Reader.ask
liftIO $ render (renderMode env) (outHandle env) message

--------------------------------------------------------------------------------
-- | Like 'say', but append a newline character.
sayLn :: Stylized -> Byline ()
sayLn message = say (message <> text "\n")

--------------------------------------------------------------------------------
-- | Read input after printing the given stylized text as a prompt.
ask :: Stylized -> Byline (Maybe Text)
ask prompt = do
mode <- Reader.asks renderMode
result <- liftInputT . getInputLine . T.unpack . renderText mode $ prompt
return (T.pack <$> result)

--------------------------------------------------------------------------------
-- | Output stylized text with a prefix determined by 'ReportType'.
report :: ReportType -> Stylized -> Byline ()
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 :: ReportType -> Stylized -> Byline ()
reportLn rt message = report rt (message <> text "\n")

--------------------------------------------------------------------------------
-- | FIXME: remove IO so that CompletionFunc can be in any monad.
withCompletionFunc :: CompletionFunc IO -> Byline a -> Byline a
withCompletionFunc comp byline =
Byline $ Reader.local updateComp (unByline byline)

where
updateComp :: Env -> Env
updateComp env = env { hlSettings = setComplete comp (hlSettings env) }

+ 0
- 1
util

@@ -1 +0,0 @@
Subproject commit 6b72793a7ef3fbaa376cbd861e50409884cce6a1

Loading…
Cancel
Save