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 -- set this to 1000 to disable all possible debug messages

  debugMessage level msg = when (level > debug) $ print msg

  colorStack :: IORef [SGR]
  {-# NOINLINE colorStack #-}
  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 "-"
      --debugMessage 1 $ getCapability t termColumns
    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 ()