module Polysemy.Commonmark where

import Relude

import Commonmark.Types (EnumeratorType(..), DelimiterType(..), ListType(..))
import Data.Text (pack)
import Polysemy (Members, Sem)
import Polysemy.Commonmark.AST
import Polysemy.Output (Output)
import Polysemy.Output.IO (putTextO, putTextLnO)
import Polysemy.Sgr (Sgr, SgrRegion, withSgr)
import System.Console.ANSI qualified as ANSI

printBlock :: Members [Output Text, Sgr, SgrRegion] r => Block -> Sem r ()
printBlock = printBlockP "" where
  printBlockP prefix (Block b) = for_ b (printBlockOne prefix)

  printBlockOne prefix (Paragraph i) = do
    putTextO prefix
    printInline i
    putTextLnO ""
  printBlockOne prefix (Plain i) = do
    putTextO prefix
    printInline i
  printBlockOne prefix ThematicBreak = do
    putTextO prefix
    putTextLnO "---"
  printBlockOne prefix (BlockQuote b) = printBlockP (prefix <> "> ") b
  printBlockOne prefix (CodeBlock lang content) = do
    putTextLnO $ prefix <> "```" <> lang
    withSgr [ANSI.SetColor ANSI.Background ANSI.Vivid ANSI.Black] do
      for_ (lines content) $ putTextLnO . (prefix <>)
    putTextLnO $ prefix <> "```"
  printBlockOne prefix (Heading lvl i) = do
    withSgr [ANSI.SetConsoleIntensity ANSI.BoldIntensity] do
      putTextO $ prefix <> pack (replicate lvl '#')
    putTextO $ prefix <> " "
    printInline i
  printBlockOne prefix (List type_ spacing blocks) =
    for_ (zip (listPrefixes type_) blocks) \(listPrefix, block) -> do
      printBlockP (prefix <> listPrefix) block
  printBlockOne prefix x = error $ "printBlockOne: " <> show x

listPrefixes :: ListType -> [Text]
listPrefixes (BulletList c) = repeat (pack [c, ' '])
listPrefixes (OrderedList start enumType delimType) =
  [start..] <&> \i -> enumFor i <> delim <> " "
  where
    infAlph list = list ++ ((<>) <$> infAlph list <*> list)
    enumFor i = case enumType of
      UpperAlpha -> infAlph (pack . one <$> ['A'..'Z']) !!? i & fromMaybe (error "Impossible")
      LowerAlpha -> infAlph (pack . one <$> ['a'..'z']) !!? i & fromMaybe (error "Impossible")
      _ -> show i
    delim = case delimType of
      Period -> "."
      OneParen -> ")"
      TwoParens -> "))"

-- TODO: needs to be aware of prefix and line length
-- and perform line wrapping
printInline :: Members [Output Text, Sgr, SgrRegion] r => Inline -> Sem r ()
printInline (Inline i) = for_ i printInlinePiece where
  printInlinePiece (Str t) = putTextO t
  printInlinePiece (WithSgr es i) = withSgr es (printInline i)