escaped (empty) → 1.0.0.0
raw patch · 10 files changed
+654/−0 lines, 10 filesdep +QuickCheckdep +basedep +doctestsetup-changed
Dependencies added: QuickCheck, base, doctest, escaped, hspec, quickcheck-instances, quickcheck-properties, text, unix
Files
- CHANGELOG.md +7/−0
- LICENSE +19/−0
- README.md +98/−0
- Setup.hs +2/−0
- app/Main.hs +62/−0
- doctest/Main.hs +6/−0
- escaped.cabal +87/−0
- src/Data/Text/Escaped.hs +322/−0
- test/Data/Text/EscapedSpec.hs +50/−0
- test/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+## [*Unreleased*](https://github.com/pbrisbin/escaped/compare/v1.0.0.0...master)++None++## [v1.0.0.0](https://github.com/pbrisbin/escaped/tree/v1.0.0.0)++- Initial release
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2018 Pat Brisbin <pbrisbin@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,98 @@+# escaped++Produce `Text` with terminal escape sequences.++## Usage++### Quick Start++```hs+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Semigroup ((<>))+import Data.Text.Escaped+import qualified Data.Text.IO as T++main :: IO ()+main = T.putStrLn $ render $ "This is " <> red "red" <> " text."+```++### Example++Running the example executable will produce everything this library currently+supports:++++### Helper Functions++The above uses the `red` helper function, which prefixes the given value with+the (foreground) color red, then resets after.++**NOTE**: this function composes `Escaped`s, so you can nest:++```hs+"This is " <> red (bg Blue "red on blue") <> " text."+```++### The `Escaped` Type++Behind those helpers, a `Semigroup` instance, and the `OverLoadedStrings`+extension, what you're actually doing is building up a value of type `Escaped`:++```console+λ> :set -XOverloadedStrings+λ> "one" <> red "red" <> "three"+Many [Plain "one",FG Red,Plain "red",Reset,Plain "three"]+λ> render it+"one\ESC[31mred\ESC[0mthree"+```++The `Escaped` type has constructors for the various shell escapes and is meant+to be used directly for non-trivial cases.++```hs+"This is " <> Blink <> FG Red <> "blinking red" <> Reset <> " text."+```++If you need to interpolate *non-literals* of type `Text`, use the `Plain`+constructor:++```hs+logMessage :: Level -> Text -> Escaped+logMessage l msg = "[" <> prefix <> "] " <> Plain msg+ where+ prefix :: Level -> Escaped+ prefix Info = blue "INFO"+ prefix Warn = yellow "WARN"+ -- etc.+```++### Terminal Applications++The `terminalRenderer` function queries if `stdout` is connected to a tty and+returns `render` or `plain` as appropriate:++```hs+main = do+ r <- terminalRenderer++ T.putStrLn $ r $+ "This will be escaped as "+ <> red "red"+ <> " only if we're connected to a tty."+```++## Development & Testing++```console+stack setup+stack build --pedantic test+```++See also the [`Makefile`](./Makefile).++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Control.Monad (forM_)+import Data.Semigroup ((<>))+import qualified Data.Text as T+import Data.Text.Escaped+import qualified Data.Text.IO as T++main :: IO ()+main = do+ forM_ simpleColors $ \(f, b) -> do+ let label = T.pack $ show f <> " on " <> show b++ T.putStrLn+ $ render+ $ "This text is "+ <> FG f+ <> BG b+ <> Plain label+ <> Reset+ <> "."++ forM_ simpleEscapes $ \e -> do+ let label = T.pack $ show e++ T.putStrLn+ $ render+ $ "This text is "+ <> e+ <> Plain label+ <> Reset+ <> "."++ forM_ [0 .. 255] $ \n -> do+ let label = Plain $ T.center 5 ' ' $ T.pack $ show n+ escaped = render $ FG White <> BG (Custom n) <> label <> Reset++ if (n + 1) `mod` 8 == 0 then T.putStrLn escaped else T.putStr escaped++simpleColors :: [(Color, Color)]+simpleColors =+ [ (Blue, Default)+ , (Cyan, Default)+ , (DarkGray, Default)+ , (Green, Default)+ , (LightBlue, Default)+ , (LightCyan, Default)+ , (LightGray, Default)+ , (LightGreen, Default)+ , (LightMagenta, Default)+ , (LightRed, Default)+ , (LightYellow, Default)+ , (Magenta, Default)+ , (Red, Default)+ , (Yellow, Default)+ , (White, Black)+ , (Black, White)+ ]++simpleEscapes :: [Escaped]+simpleEscapes = [Bold, Dim, Underlined, Blink, Reverse, Hidden]
+ doctest/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Test.DocTest++main :: IO ()+main = doctest ["-XOverloadedStrings", "src"]
+ escaped.cabal view
@@ -0,0 +1,87 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 5730e4ee8bb5cfa0d5c8c39f5c26a891cfec88419d74f15fc0e4fe7e75f69ed1++name: escaped+version: 1.0.0.0+synopsis: Produce Text with terminal escape sequences+description: See README.md+category: Text+homepage: https://github.com/pbrisbin/escaped#readme+bug-reports: https://github.com/pbrisbin/escaped/issues+author: Patrick Brisbin+maintainer: pbrisbin@gmail.com+copyright: 2018 Patrick Brisbin+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/pbrisbin/escaped++library+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , quickcheck-instances+ , text+ , unix+ exposed-modules:+ Data.Text.Escaped+ other-modules:+ Paths_escaped+ default-language: Haskell2010++executable escaped-example+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , escaped+ , text+ other-modules:+ Paths_escaped+ default-language: Haskell2010++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ doctest+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , doctest+ other-modules:+ Paths_escaped+ default-language: Haskell2010++test-suite hspec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , escaped+ , hspec+ , quickcheck-properties+ other-modules:+ Data.Text.EscapedSpec+ Paths_escaped+ default-language: Haskell2010
+ src/Data/Text/Escaped.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.Text.Escaped+ ( Escaped+ ( Plain+ , Reset+ , Bold+ , Dim+ , Underlined+ , Blink+ , Reverse+ , Hidden+ , FG+ , BG+ )+ , Color(..)+ , black+ , blue+ , cyan+ , darkGray+ , green+ , lightBlue+ , lightCyan+ , lightGray+ , lightGreen+ , lightMagenta+ , lightRed+ , lightYellow+ , magenta+ , red+ , white+ , yellow+ , fg+ , bg+ , esc+ , render+ , plain+ , visibleLength+ , terminalRenderer+ ) where++import Data.Semigroup (Semigroup(..))+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T+import System.Posix.IO (stdOutput)+import System.Posix.Terminal (queryTerminal)+import Test.QuickCheck+import Test.QuickCheck.Instances.Text ()++-- | Supported colors+data Color+ = Default+ | Custom Int+ | Black+ | Blue+ | Cyan+ | DarkGray+ | Green+ | LightBlue+ | LightCyan+ | LightGray+ | LightGreen+ | LightMagenta+ | LightRed+ | LightYellow+ | Magenta+ | Red+ | White+ | Yellow+ deriving (Eq, Show)++instance Arbitrary Color where+ -- Too bad @Custom@ makes arbitraryBoundedEnum not useful+ arbitrary = oneof+ [ pure Default+ , Custom <$> arbitrary+ , pure Black+ , pure Blue+ , pure Cyan+ , pure DarkGray+ , pure Green+ , pure LightBlue+ , pure LightCyan+ , pure LightGray+ , pure LightGreen+ , pure LightMagenta+ , pure LightRed+ , pure LightYellow+ , pure Magenta+ , pure Red+ , pure White+ , pure Yellow+ ]++-- | Bits of escaped text+data Escaped+ = Plain Text+ | Reset+ | Bold+ | Dim+ | Underlined+ | Blink+ | Reverse+ | Hidden+ | FG Color+ | BG Color+ | Many [Escaped]+ deriving (Eq, Show)++instance Arbitrary Escaped where+ -- Avoid invalid Many-of-Many nesting, which triggers an infinite loop. Such+ -- a value is impossible to construct because we don't export the Many+ -- constructor.+ arbitrary = oneof $ chunks <> [Many <$> listOf1 (oneof chunks)]+ where+ chunks =+ [ Plain <$> arbitrary+ , pure Reset+ , pure Bold+ , pure Dim+ , pure Underlined+ , pure Blink+ , pure Reverse+ , pure Hidden+ , FG <$> arbitrary+ , BG <$> arbitrary+ ]++instance IsString Escaped where+ fromString = Plain . T.pack++instance Semigroup Escaped where+ -- A bit explicit, but ensures identity works+ x <> (Plain t) | T.null t = x+ (Plain t) <> y | T.null t = y++ (Many a) <> (Many b) = Many $ a <> b+ (Many a) <> b = Many $ a <> [b]+ a <> (Many b) = Many $ a:b+ a <> b = Many [a, b]++instance Monoid Escaped where+ mempty = Plain ""+ mappend = (<>)++-- | Render an @'Escaped'@ to actually-escaped @'Text'@+--+-- Examples:+--+-- >>> render "Some text via OverloadedStrings."+-- "Some text via OverloadedStrings."+--+-- >>> render $ Plain "Some text."+-- "Some text."+--+-- >>> render $ "Some " <> FG Red <> "red" <> Reset <> " text."+-- "Some \ESC[31mred\ESC[0m text."+--+-- >>> render $ "Some " <> blue "blue" <> " text."+-- "Some \ESC[34mblue\ESC[0m text."+--+-- >>> render $ "Some " <> fg (Custom 212) "color 212" <> " text."+-- "Some \ESC[38;5;212mcolor 212\ESC[0m text."+--+render :: Escaped -> Text+render (Plain t) = t+render (Many es) = T.concat $ map render es+render Reset = "\ESC[0m"+render Bold = "\ESC[1m"+render Dim = "\ESC[2m"+render Underlined = "\ESC[3m"+render Blink = "\ESC[5m"+render Reverse = "\ESC[7m"+render Hidden = "\ESC[8m"+render (FG c) = "\ESC[" <> fgColorCode c <> "m"+render (BG c) = "\ESC[" <> bgColorCode c <> "m"++-- | Render only the @'Text'@ parts+--+-- Examples+--+-- >>> plain $ Plain "Some text."+-- "Some text."+--+-- >>> plain $ "Some " <> FG Red <> "red" <> Reset <> " text."+-- "Some red text."+--+plain :: Escaped -> Text+plain (Plain t) = t+plain (Many es) = T.concat $ map plain es+plain _ = ""++black :: Escaped -> Escaped+black = fg Black++blue :: Escaped -> Escaped+blue = fg Blue++cyan :: Escaped -> Escaped+cyan = fg Cyan++darkGray :: Escaped -> Escaped+darkGray = fg DarkGray++green :: Escaped -> Escaped+green = fg Green++lightBlue :: Escaped -> Escaped+lightBlue = fg LightBlue++lightCyan :: Escaped -> Escaped+lightCyan = fg LightCyan++lightGray :: Escaped -> Escaped+lightGray = fg LightGray++lightGreen :: Escaped -> Escaped+lightGreen = fg LightGreen++lightMagenta :: Escaped -> Escaped+lightMagenta = fg LightMagenta++lightRed :: Escaped -> Escaped+lightRed = fg LightRed++lightYellow :: Escaped -> Escaped+lightYellow = fg LightYellow++magenta :: Escaped -> Escaped+magenta = fg Magenta++red :: Escaped -> Escaped+red = fg Red++white :: Escaped -> Escaped+white = fg White++yellow :: Escaped -> Escaped+yellow = fg Yellow++-- | Escape with foreground @'Color'@, then @'Reset'@+--+-- >>> fg Red "red"+-- Many [FG Red,Plain "red",Reset]+--+fg :: Color -> Escaped -> Escaped+fg = esc . FG++-- | Escape with background @'Color'@, then @'Reset'@+--+-- >>> bg Red "red"+-- Many [BG Red,Plain "red",Reset]+--+bg :: Color -> Escaped -> Escaped+bg = esc . BG++-- | Apply the given escape, then @'Reset'@+--+-- >>> esc (FG Red) "red"+-- Many [FG Red,Plain "red",Reset]+--+esc :: Escaped -> Escaped -> Escaped+esc a b = a <> b <> Reset++-- | Calculate the /visible/ length of an @'Escaped'@+visibleLength :: Escaped -> Int+visibleLength (Plain t) = T.length t+visibleLength (Many es) = sum $ map visibleLength es+visibleLength _ = 0++-- | An @'IO'@ action to produce the appropriate renderer for a terminal+--+-- Returns @'render'@ if @stdout@ is a terminal, otherwise @'plain'@+--+-- >>> r <- terminalRenderer+-- >>> print $ r $ red "red text"+-- "red text"+--+terminalRenderer :: IO (Escaped -> Text)+terminalRenderer = do+ istty <- queryTerminal stdOutput+ return $ if istty then render else plain++fgColorCode :: Color -> Text+fgColorCode Default = "39"+fgColorCode (Custom n) = "38;5;" <> T.pack (show n)+fgColorCode Black = "30"+fgColorCode Blue = "34"+fgColorCode Cyan = "36"+fgColorCode DarkGray = "90"+fgColorCode Green = "32"+fgColorCode LightBlue = "94"+fgColorCode LightCyan = "96"+fgColorCode LightGray = "37"+fgColorCode LightGreen = "92"+fgColorCode LightMagenta = "95"+fgColorCode LightRed = "91"+fgColorCode LightYellow = "93"+fgColorCode Magenta = "35"+fgColorCode Red = "31"+fgColorCode White = "97"+fgColorCode Yellow = "33"++bgColorCode :: Color -> Text+bgColorCode Default = "49"+bgColorCode (Custom n) = "48;5;" <> T.pack (show n)+bgColorCode Black = "40"+bgColorCode Blue = "44"+bgColorCode Cyan = "46"+bgColorCode DarkGray = "100"+bgColorCode Green = "42"+bgColorCode LightBlue = "104"+bgColorCode LightCyan = "106"+bgColorCode LightGray = "100"+bgColorCode LightGreen = "102"+bgColorCode LightMagenta = "105"+bgColorCode LightRed = "101"+bgColorCode LightYellow = "103"+bgColorCode Magenta = "45"+bgColorCode Red = "41"+bgColorCode White = "107"+bgColorCode Yellow = "103"
+ test/Data/Text/EscapedSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Text.EscapedSpec+ ( spec+ ) where++import Control.Monad (forM_)+import Data.Semigroup ((<>))+import Data.Text.Escaped+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Property.Monoid++-- brittany-disable-next-binding++spec :: Spec+spec = do+ describe "Escaped" $ do+ it "is a Monoid" $ property+ $ eq $ prop_Monoid (T :: T Escaped)++ describe "visibleLength" $ do+ it "calculates the visible length of escaped text" $ do+ let l1 = visibleLength "Some text."+ l2 = visibleLength $ FG Red <> "Some text" <> Reset <> "."++ l1 `shouldBe` 10+ l2 `shouldBe` 10++ describe "foreground color helpers" $ do+ forM_+ [ (black, Black)+ , (blue, Blue)+ , (cyan, Cyan)+ , (darkGray, DarkGray)+ , (green, Green)+ , (lightBlue, LightBlue)+ , (lightCyan, LightCyan)+ , (lightGray, LightGray)+ , (lightGreen, LightGreen)+ , (lightMagenta, LightMagenta)+ , (lightRed, LightRed)+ , (lightYellow, LightYellow)+ , (magenta, Magenta)+ , (red, Red)+ , (white, White)+ , (yellow, Yellow)+ ]+ $ \(h, c) -> it ("uses the correct color for " <> show c) $+ h "hi" `shouldBe` FG c <> Plain "hi" <> Reset
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}