{-# LANGUAGE OverloadedStrings #-}

module Tldr
  ( parsePage
  , renderPage
  , ConsoleSetting(..)
  , defConsoleSetting
  , headingSetting
  , toSGR
  , renderNode
  , changeConsoleSetting
  ) where

import Data.Text
import qualified Data.Text.IO as TIO
import CMark
import System.Console.ANSI
import Data.Monoid ((<>))

data ConsoleSetting = ConsoleSetting
  { italic :: Bool
  , underline :: Underlining
  , blink :: BlinkSpeed
  , fgIntensity :: ColorIntensity
  , fgColor :: Color
  , bgIntensity :: ColorIntensity
  , bgColor :: Color
  , consoleIntensity :: ConsoleIntensity
  }

defConsoleSetting :: ConsoleSetting
defConsoleSetting =
  ConsoleSetting
  { italic = False
  , underline = NoUnderline
  , blink = NoBlink
  , fgIntensity = Dull
  , fgColor = White
  , bgIntensity = Dull
  , bgColor = Black
  , consoleIntensity = NormalIntensity
  }

headingSetting :: ConsoleSetting
headingSetting =
  defConsoleSetting
  { consoleIntensity = BoldIntensity
  }

toSGR :: ConsoleSetting -> [SGR]
toSGR cons =
  [ SetItalicized (italic cons)
  , SetConsoleIntensity (consoleIntensity cons)
  , SetUnderlining (underline cons)
  , SetBlinkSpeed (blink cons)
  , SetColor Foreground (fgIntensity cons) (fgColor cons)
  , SetColor Background (bgIntensity cons) (bgColor cons)
  ]

renderNode :: NodeType -> IO ()
renderNode (TEXT txt) = TIO.putStrLn txt
renderNode (HTML_BLOCK txt) = TIO.putStrLn txt
renderNode (CODE_BLOCK _ txt) = TIO.putStrLn txt
renderNode (HTML_INLINE txt) = TIO.putStrLn txt
renderNode (CODE txt) = TIO.putStrLn ("   " <> txt)
renderNode LINEBREAK = TIO.putStrLn ""
renderNode (LIST _) = TIO.putStrLn "" >> TIO.putStr " - "
renderNode _ = return ()

changeConsoleSetting :: NodeType -> IO ()
changeConsoleSetting (HEADING _) = setSGR $ toSGR headingSetting
changeConsoleSetting BLOCK_QUOTE = setSGR $ toSGR headingSetting
changeConsoleSetting ITEM =
  setSGR $
  toSGR $
  defConsoleSetting
  { fgColor = Green
  }
changeConsoleSetting (CODE _) =
  setSGR $
  toSGR $
  defConsoleSetting
  { fgColor = Yellow
  }
changeConsoleSetting _ = return ()

handleNode :: Node -> IO ()
handleNode (Node _ ntype xs) = do
  changeConsoleSetting ntype
  renderNode ntype
  mapM_ (\(Node _ ntype' ns) -> renderNode ntype' >> mapM_ handleNode ns) xs

parsePage :: FilePath -> IO Node
parsePage fname = do
  page <- TIO.readFile fname
  let node = commonmarkToNode [] page
  return node

renderPage :: FilePath -> IO ()
renderPage fname = do
  node <- parsePage fname
  handleNode node