module FunnyPrint ( Colored
, escapeQuotes
, funnyPrint
, funnyPrintC
, prompt
, prompt2
) where
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
)
escapeQuotes :: 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
cyan :: Highlight
cyan = Foreground Cyan
bold :: Highlight
bold = Bold
type Colored = Bool
funnyPrintC :: (Show a) => a
-> IO ()
funnyPrintC = funnyPrint' True
funnyPrint :: (Show a) => a
-> IO ()
funnyPrint = funnyPrint' False
withUTF :: String -> String
withUTF [] = []
withUTF li@(x:xs) | x == '\"' = '\"':str ++ "\"" ++ (withUTF rest)
| x == '\'' = '\'':chr:'\'':(withUTF rest')
| otherwise = x:withUTF xs
where
(str, rest):_ = reads li :: [(String, String)]
(chr, rest'):_ = reads li :: [(Char, String)]
funnyPrint' :: (Show a) => Colored
-> a
-> IO ()
funnyPrint' c = putStrLn .withUTF . 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 :: String
-> String
-> String
-> String
prompt m t s = mark yellow
++ m
++ mark green
++ t
++ mark blue
++ s
++ highlightOff
prompt2 :: String
-> String
-> String
-> String
prompt2 m t s = mark yellow
++ m
++ mark green
++ t
++ mark red
++ s
++ highlightOff