diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for pretty-terminal + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Logan McPhail (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,43 @@ +# pretty-terminal + +## Example + +```haskell +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Data.Text.IO as T +import System.Console.Pretty (Color (..), Style (..), bgColor, color, + style, supportsPretty) + +main :: IO () +main = do + inColor <- supportsPretty + if inColor then example + else putStrLn "Sorry, this terminal doesn't support pretty ANSI codes" + +example :: IO () +example = do + -- simple style + putStrLn ( style Underline "hello there!" ) + + -- simple color + putStrLn ( color Yellow "this lib was designed to be easy" ) + + -- simple background + putStrLn ( bgColor Blue "and the functions layer together easily" ) + + -- combining + putStrLn ( bgColor White . color Red . style Bold $ "like so!" ) + + -- custom style & color + let primary = bgColor Magenta . color Green . style Italic + putStrLn ( primary "easily create your own helpers & styles" ) + + -- with both unicode string types + putStrLn ( color Cyan "String...") + T.putStrLn (color Red "and Text") + + -- set styling to none + putStrLn ( primary $ style Normal "or if you need to remove any styling..." ) +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Main.hs b/examples/Main.hs new file mode 100644 --- /dev/null +++ b/examples/Main.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Data.Text.IO as T +import System.Console.Pretty (Color (..), Style (..), bgColor, color, + style, supportsPretty) + +main :: IO () +main = do + inColor <- supportsPretty + if inColor then example + else putStrLn "Sorry, this terminal doesn't support pretty ANSI codes" + +example :: IO () +example = do + -- simple style + putStrLn ( style Underline "hello there!" ) + + -- simple color + putStrLn ( color Yellow "this lib was designed to be easy" ) + + -- simple background + putStrLn ( bgColor Blue "and the functions layer together easily" ) + + -- combining + putStrLn ( bgColor White . color Red . style Bold $ "like so!" ) + + -- custom style & color + let primary = bgColor Magenta . color Green . style Italic + putStrLn ( primary "easily create your own helpers & styles" ) + + -- with both unicode string types + putStrLn ( color Cyan "String...") + T.putStrLn (color Red "and Text") + + -- set styling to none + putStrLn ( primary $ style Normal "or if you need to remove any styling..." ) diff --git a/pretty-terminal.cabal b/pretty-terminal.cabal new file mode 100644 --- /dev/null +++ b/pretty-terminal.cabal @@ -0,0 +1,54 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: da906ab4d9433b9aa0f41e4f11e0799d878090ed582ff8dd719687946ddcecd5 + +name: pretty-terminal +version: 0.1.0.0 +synopsis: Styling and coloring terminal output with ANSI escape sequences. +description: Please see the README on Github at +category: Terminal +homepage: https://github.com/loganmac/pretty-terminal#readme +bug-reports: https://github.com/loganmac/pretty-terminal/issues +author: Logan McPhail +maintainer: logan.airnomad@gmail.com +copyright: 2018 Logan McPhail +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/loganmac/pretty-terminal + +library + hs-source-dirs: + src + ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wtabs + build-depends: + base >=4.7 && <5 + , text + exposed-modules: + System.Console.Pretty + other-modules: + Paths_pretty_terminal + default-language: Haskell2010 + +executable example + main-is: Main.hs + hs-source-dirs: + examples + ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wtabs -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , pretty-terminal + , text + other-modules: + Paths_pretty_terminal + default-language: Haskell2010 diff --git a/src/System/Console/Pretty.hs b/src/System/Console/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/System/Console/Pretty.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-| Useful helpers to style and color text with ANSI escape sequences. +-} +module System.Console.Pretty +( Color(..) , Pretty(..) , Section(..) , Style(..) +, supportsPretty) +where + +import qualified Data.Char as C +import Data.Monoid ((<>)) +import qualified Data.Text as T +import GHC.IO.Handle (Handle) +import System.Environment (lookupEnv) +import System.IO (hIsTerminalDevice, stdout) + +--------------------------------------------------------------------------------- +-- TYPES + +-- | A section to be colored, either foreground or background. +data Section = Foreground | Background + +-- | Colors for an ANSI terminal +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default + deriving (Enum) + +-- | SGR paramaters, aka text styles for an ANSI terminal +data Style + = Normal | Bold | Faint | Italic + | Underline | SlowBlink | ColoredNormal | Reverse + deriving (Enum) + + +--------------------------------------------------------------------------------- +-- CLASS + +-- | A class to color and style +class Pretty a where + -- | Helper to set foreground color + color :: Color -> a -> a + color = colorize Foreground + -- | Helper to set background color + bgColor :: Color -> a -> a + bgColor = colorize Background + -- | Set the color of the (fg/bg) with the color + colorize :: Section -> Color -> a -> a + -- | Set the style + style :: Style -> a -> a + +--------------------------------------------------------------------------------- +-- TEXT + +-- | Instance of `Pretty` for `T.Text` +instance Pretty T.Text where + colorize section col str = + "\x1b[" <> -- escape code + sectionNum <> -- bg/foreground + (T.singleton $ C.intToDigit $ fromEnum col) -- color code + <> "m" <> -- delim + str <> -- inner string + "\x1b[0m" -- reset + where + sectionNum :: T.Text + sectionNum = case section of + Foreground -> "9" + Background -> "4" + + style sty str = + "\x1b[" <> -- escape code + (T.singleton $ C.intToDigit $ fromEnum sty) -- style + <> "m" <> -- delim + str <> -- inner string + "\x1b[0m" -- reset + +--------------------------------------------------------------------------------- +-- STRING + +-- | Instance of `Pretty` for `String` +instance Pretty String where + colorize section col str = + "\x1b[" <> -- escape code + sectionNum <> -- bg/foreground + show (fromEnum col) -- color code + <> "m" <> -- delim + str <> -- inner string + "\x1b[0m" -- reset + where + sectionNum :: String + sectionNum = case section of + Foreground -> "9" + Background -> "4" + + style sty str = + "\x1b[" <> -- escape code + show (fromEnum sty) -- style + <> "m" <> -- delim + str <> -- string + "\x1b[0m" -- reset + + +--------------------------------------------------------------------------------- +-- SUPPORTED CHECK + +-- | Whether or not the current terminal supports pretty-terminal +supportsPretty :: IO Bool +supportsPretty = + hSupportsANSI stdout + where + -- | Use heuristics to determine whether the functions defined in this + -- package will work with a given handle. + -- + -- The current implementation checks that the handle is a terminal, and + -- that the @TERM@ environment variable doesn't say @dumb@ (whcih is what + -- Emacs sets for its own terminal). + hSupportsANSI :: Handle -> IO Bool + -- Borrowed from an HSpec patch by Simon Hengel + -- (https://github.com/hspec/hspec/commit/d932f03317e0e2bd08c85b23903fb8616ae642bd) + hSupportsANSI h = (&&) <$> hIsTerminalDevice h <*> (not <$> isDumb) + where + isDumb = (== Just "dumb") <$> lookupEnv "TERM"