funnyprint-0.0.4: library/FunnyPrint.hs

-- | funnyPrint function to colorize GHCi output. See @FunnyPrint.funnyPrint@.
module FunnyPrint ( Colored
                  , escapeQuotes
                  , funnyPrint
                  , funnyPrintC
                  , prompt
                  , prompt2
                  ) where

import System.Posix.Escape.Unicode ( escape )
import IPPrint ( pshow )
import Language.Haskell.HsColour.Output ( TerminalType(..) )
import Language.Haskell.HsColour.Colourise ( Colour(..)
                                           , Highlight(..)
                                           , defaultColourPrefs
                                           )
import Language.Haskell.HsColour ( ColourPrefs(..)
                                 , Output(TTYg)
                                 , hscolour
                                 )
import Language.Haskell.HsColour.ANSI ( highlightOnG
                                      , highlightOff
                                      )
-- | Escape quoutes in string.
escapeQuotes :: String -- ^ handled string
             -> String
escapeQuotes arg = "'" ++ ((\c -> if c == '\'' then "'\"'\"'" else [c]) =<< arg) ++"'"

term    :: TerminalType
term    = XTerm256Compatible

black   :: Highlight
black   = Foreground Black

red     :: Highlight
red     = Foreground Red

green   :: Highlight
green   = Foreground Green

yellow  :: Highlight
yellow  = Foreground Yellow

blue    :: Highlight
blue    = Foreground Blue

-- magenta :: Highlight
-- magenta = Foreground Magenta

cyan    :: Highlight
cyan    = Foreground Cyan

-- white   :: Highlight
-- white   = Foreground White

bold    :: Highlight
bold    = Bold

type Colored = Bool

-- | UTF8 support. Smart indentatntion. Use as @:set -interactive-print=funnyPrintC@.
funnyPrintC :: (Show a) => a -- ^ printed input
            -> IO ()
funnyPrintC = funnyPrint' True

-- | Colorize GHCi. UTF8 support. Smart indentatntion. Use as @:set -interact
funnyPrint :: (Show a) => a -- ^ printed input
           -> IO ()
funnyPrint = funnyPrint' False

-- | internal helper, use 'funnyPrint' or 'funnyPrintC'
funnyPrint'   :: (Show a) => Colored -- ^ enable colors in prompt
              -> a                   -- ^ printed input
              -> IO ()
funnyPrint' c = putStrLn .escape . if c then colorize . pshow else pshow
  where
    prefs = TTYg term
    colorize = hscolour prefs colours False False "" False
    colours = defaultColourPrefs { conid    = [ yellow, bold ]
                                 , conop    = [ yellow ]
                                 , string   = [ green ]
                                 , char     = [ cyan ]
                                 , number   = [ red, bold ]
                                 , layout   = [ black ]
                                 , keyglyph = [ black ]
                                 }

mark   :: Highlight -> String
mark h = highlightOnG term [h, bold]

-- | Prompt for GHCi.
prompt :: String -- ^ marker
       -> String -- ^ message
       -> String -- ^ separator
       -> String
prompt m t s = mark yellow
            ++ m
            ++ mark green
            ++ t
            ++ mark blue
            ++ s
            ++ highlightOff

-- | Second prompt for multiline GHCi.
prompt2 :: String -- ^ marker
        -> String -- ^ message
        -> String -- ^ separator
        -> String
prompt2 m t s = mark yellow
             ++ m
             ++ mark green
             ++ t
             ++ mark red
             ++ s
             ++ highlightOff