module Mdcat(
render,
debugMessage
) where
import System.Environment (getArgs, lookupEnv)
import Text.Pandoc
import System.Directory
import System.Console.ANSI
import Control.Monad
import System.Console.Terminfo.Base
import System.Console.Terminfo.Cursor
import Data.IORef
import System.IO.Unsafe
debug = 1000
debugMessage level msg = when (level > debug) $ print msg
colorStack :: IORef [SGR]
colorStack = unsafePerformIO $ newIORef []
pushtToColorStack :: SGR -> IO ()
pushtToColorStack s = modifyIORef colorStack (s:)
popFromColorStack :: IO (Maybe SGR)
popFromColorStack = do
cs <- readIORef colorStack
case cs of
[] -> return Nothing
(s:ss) -> do
modifyIORef colorStack (drop 1)
return $ Just s
alterColor :: SGR -> IO() -> IO ()
alterColor s ios = do
c <- popFromColorStack
setSGR [s]
pushtToColorStack s
ios
case c of
Nothing -> setSGR []
Just ns -> if ns == s then setSGR [] else setSGR [ns]
duplicate :: Int -> String -> String
duplicate n string = concat $ replicate n string
renderInline :: Inline -> IO ()
renderInline i = case i of
Str i -> putStr i
Space -> putStr " "
Emph i -> do
setSGR [SetItalicized True, SetConsoleIntensity BoldIntensity]
renderInlines i
setSGR [SetItalicized False, SetConsoleIntensity NormalIntensity]
Link is t -> alterColor (SetColor Foreground Dull Green) ((\() -> do
putStr "["
renderInlines is
putStr "]"
putStr "("
putStr $ fst t
putStr ")") ())
_ -> return ()
renderInlines :: [Inline] -> IO ()
renderInlines = mapM_ renderInline
renderElement :: Block -> IO ()
renderElement e = case e of
Header level attr inline ->
alterColor (SetColor Foreground Dull Red) ((\() -> do
renderInlines inline
putStrLn "") ())
Para inline -> do
renderInlines inline
putStrLn ""
Plain inline -> renderInlines inline
HorizontalRule -> do
t <- setupTermFromEnv
let mc = getCapability t termColumns in case mc of
Nothing -> putStrLn $ duplicate 80 "-"
Just c -> putStrLn $ duplicate c "-"
BulletList (b:bs) -> do
putStr " * "
renderBlocks b
putStrLn ""
renderElement (BulletList bs)
_ -> return ()
renderBlocks :: [Block] -> IO ()
renderBlocks = mapM_ renderElement
render :: Pandoc -> IO ()
render md = case md of
Pandoc m b -> renderBlocks b >> do
cs <- readIORef colorStack
return ()