{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Djot
  ( document,
    metadata,
  )
where

import Control.Applicative (many, some, (<|>))
import Control.Monad.Trans.Accum (accum)
import Data.Functor (void, (<$>), (<&>))
import Data.Text (Text)
import qualified Data.Text as T
import IR
import Logger (Logger (logCallStack, logDebug))
import Text.Megaparsec (MonadParsec (lookAhead, notFollowedBy, try), anySingle, choice, manyTill, sepBy)
import Text.Megaparsec.Char (char, newline, space, string)
import Utilities.Parsing

(.>) :: (a -> b) -> (b -> c) -> a -> c
(.>) = flip (.)

metadata :: (Logger m, Characters s) => Parser s m Text
metadata = T.pack <$> many (notFollowedBy (string "---") *> anySingle)

document :: (Logger m, Characters s) => Parser s m Document
document = Doc <$> blockElement mempty `sepBy` blockSeparator

blockElement :: (Logger m, Characters s) => Attrs -> Parser s m Element
-- skip is for blockQuote to allow
blockElement accumulated_attributes =
  choice
    [ lookAhead (char '#') *> header accumulated_attributes,
      lookAhead (char '>') *> blockQuote accumulated_attributes,
      lookAhead listMarker
        *> (lookAhead taskMarker *> taskListBlock accumulated_attributes)
        <|> listBlock accumulated_attributes,
      lookAhead codeFence
        *> (lookAhead rawLang *> rawBlock accumulated_attributes)
        <|> codeBlock accumulated_attributes,
      -- Why lookAhead when checking is fully equivalent to parsing
      try $ thematicBreak accumulated_attributes,
      lookAhead (string ":::") *> containerBlock accumulated_attributes,
      lookAhead tableRow *> tableBlock accumulated_attributes,
      lookAhead (char '[')
        *> (lookAhead (char '^') *> footnoteDefinition accumulated_attributes)
        <|> referenceDef accumulated_attributes,
      lookAhead (char '{') *> blockAttribute accumulated_attributes,
      paragraph accumulated_attributes
    ]
  where
    rawLang = space *> char '=' *> some (notFollowedBy newline *> anySingle)
    taskMarker = void $ char '[' *> choice (map char " xX") *> char ']'

header :: (Logger m, Characters s) => Attrs -> Parser s m Element
header = error "todo"

blockQuote :: (Logger m, Characters s) => Attrs -> Parser s m Element
blockQuote = error "todo"

listBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
listBlock = error "todo"

listMarker :: (Logger m, Characters s) => Parser s m ListType
listMarker = error "todo"

codeFence :: (Logger m, Characters s) => Parser s m ()
codeFence = void $ string "```"

codeBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
codeBlock = error "todo"

paragraph :: (Logger m, Characters s) => Attrs -> Parser s m Element
paragraph = error "todo"

blockAttribute :: (Logger m, Characters s) => Attrs -> Parser s m Element
blockAttribute attrs = (blockAttribute' <&> (attrs <>) >>= blockElement) <|> error "eof handle"

blockAttribute' :: (Logger m, Characters s) => Parser s m Attrs
blockAttribute' = error "todo"

blockSeparator :: (Logger m, Characters s) => Parser s m ()
blockSeparator = void $ newline *> newline

taskListBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
taskListBlock = error "todo"

referenceDef :: (Logger m, Characters s) => Attrs -> Parser s m Element
referenceDef = error "todo"

rawBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
rawBlock = error "todo"

thematicBreak :: (Logger m, Characters s) => Attrs -> Parser s m Element
thematicBreak = error "todo"

containerBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
containerBlock = error "todo"

tableBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
tableBlock = error "todo"

tableRow :: (Logger m, Characters s) => Parser s m Element
tableRow = error "todo"

footnoteDefinition :: (Logger m, Characters s) => Attrs -> Parser s m Element
footnoteDefinition = error "todo"