{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# LANGUAGE LambdaCase #-}

module Assignment (markdownParser, convertADTHTML, getTime) where

import           Debug.Trace            (trace)
import           Data.Time.Clock        (getCurrentTime)
import           Data.Time.Format       (defaultTimeLocale, formatTime)
import           Instances              (ParseError(..), ParseResult(..), Parser(..), parse)
import           Parser                 hiding (unexpectedCharParser)

import           Control.Monad          (guard)
import           Control.Applicative    (Alternative(..), optional, many)
import           Data.Char              (isDigit, isSpace)
import           Data.Maybe             (fromMaybe)
import           Data.Functor           (void)

-- Define the ADT
data ADT = Document [Block]
  deriving (Show, Eq)

-- Utilize the 'try' combinator from Parser
try :: Parser a -> Parser a
try pa = pa <|> empty

choice :: [Parser a] -> Parser a
choice = foldr (<|>) empty

endOfLineOrEOF :: Parser ()
endOfLineOrEOF = void eol <|> eof

lookAhead :: Parser a -> Parser a
lookAhead pa = Parser $ \input ->
    case parse pa input of
        Error e    -> Error e
        Result _ x -> Result input x

many1 :: Alternative f => f a -> f [a]
many1 p = (:) <$> p <*> many p

sepBy :: Parser a -> Parser sep -> Parser [a]
sepBy p sep = sepBy1 p sep <|> pure []

data Block
    = Paragraph [Inline]
    | Heading Int [Inline]
    | BlockQuote [Block]
    | CodeBlock (Maybe String) String
    | OrderedList [ListItem]
    | FootnoteReference Int String
    | Table TableRow [TableRow]
    deriving (Show, Eq)

data ListItem = ListItem [Block]
    deriving (Show, Eq)

data TableRow = TableRow [[Inline]]
    deriving (Show, Eq)

data Inline
    = Plain String
    | Italic [Inline]
    | Bold [Inline]
    | Strikethrough [Inline]
    | Link [Inline] String
    | Image String String (Maybe String)
    | InlineCode String
    | Footnote Int
    deriving (Show, Eq)

-- Utility functions
space1 :: Parser String
space1 = some (satisfy (\c -> isSpace c && c /= '\n' && c /= '\r'))

-- | Parses an end-of-line sequence.
-- Handles Unix (\n), Windows (\r\n), and old Mac (\r) line endings.
eol :: Parser ()
eol = 
      (void (string "\r\n"))    -- Windows-style EOL
  <|> (void (is '\n'))         -- Unix-style EOL
  <|> (void (is '\r'))         -- Old Mac-style EOL

anyChar :: Parser Char
anyChar = satisfy (const True)

anyCharButNewline :: Parser Char
anyCharButNewline = satisfy (\c -> c /= '\n' && c /= '\r')

skipMany :: Parser a -> Parser ()
skipMany p = void (many p)

manyTill :: Parser a -> Parser end -> Parser [a]
manyTill p end = scan
  where
    scan = (end *> pure []) <|> (p >>= \x -> (x:) <$> scan)

sepBy1 :: Parser a -> Parser sep -> Parser [a]
sepBy1 p sep = (:) <$> p <*> many (sep *> p)

-- Part A: Parsing Markdown

markdownParser :: Parser ADT
markdownParser = do
  blocks <- sepEndBy1 blockParser (some eol)
  eof
  return $ Document blocks

blockParser :: Parser Block
blockParser = choice
  [ try headingParser
  , try codeBlockParser
  , try blockQuoteParser
  , try orderedListParser
  , try footnoteReferenceParser
  , try tableParser
  , try imageBlockParser
  , paragraphParser
  ]

-- Adjusted headingParser to handle setext-style headings
headingParser :: Parser Block
headingParser = try atxHeadingParser <|> try setextHeadingParser

headingStartParser :: Parser ()
headingStartParser = lookAhead $ do
    optional inlineSpace
    (do
        hashes <- some (is '#')
        guard (length hashes <= 6)
        space1
        return ())
    <|>
    (do
        content <- inlineContentLine
        eol
        skipMany (satisfy isSpace)
        c <- satisfy (\c -> c == '=' || c == '-')
        cs <- many (satisfy (\x -> x == c))
        skipMany (satisfy isSpace)
        endOfLineOrEOF
        guard (length (c:cs) >= 2)
        return ())

atxHeadingParser :: Parser Block
atxHeadingParser = do
    optional inlineSpace
    hashes <- some (is '#')          -- Capture the number of `#`
    guard (length hashes <= 6)       -- Ensure valid heading level
    space1                           -- Require at least one space
    content <- manyTill inlineElement (lookAhead eol <|> try eof) -- Parse heading up to EOL or EOF
    return $ Heading (length hashes) content

setextHeadingParser :: Parser Block
setextHeadingParser = do
    content <- some inlineElement     -- Ensure non-empty content
    eol                              -- Expect a newline
    skipMany (satisfy isSpace)        -- Skip spaces
    c <- satisfy (\c -> c == '=' || c == '-') -- Check for '=' or '-'
    rest <- many (satisfy (\x -> x == c || isSpace x)) -- Capture the rest of the line
    guard (all (\x -> x == c || isSpace x) (c:rest))  -- Ensure separator line has only 'c' and spaces
    endOfLineOrEOF                  -- Ensure the block ends correctly
    let level = if c == '=' then 1 else 2  -- Determine heading level
    return $ Heading level content

blockQuoteParser :: Parser Block
blockQuoteParser = do
    blocks <- some blockQuoteBlock
    return $ BlockQuote blocks

blockQuoteBlock :: Parser Block
blockQuoteBlock = do
    optional (satisfy isSpace)
    is '>'
    optional (is ' ')
    content <- manyTill anyChar (lookAhead eol <|> eof)
    _ <- optional eol
    parsedContent <- parseInlineContent content
    return $ Paragraph parsedContent

codeBlockParser :: Parser Block
codeBlockParser = do
    optional inlineSpace
    string "```"
    lang <- optional (some (satisfy (/= '\n')))
    eol
    code <- manyTill anyChar (try $ optional inlineSpace *> string "```" *> endOfLineOrEOF)
    return $ CodeBlock lang code

orderedListParser :: Parser Block
orderedListParser = do
    items <- some orderedListItemParser
    return $ OrderedList items

orderedListItemParser :: Parser ListItem
orderedListItemParser = do
    optional inlineSpace
    numStr <- some digit
    is '.'
    space1
    content <- manyTill anyCharButNewline (lookAhead eol <|> eof)
    _ <- optional eol
    subItems <- optional (try orderedListParser)
    parsedContent <- parseBlocks content
    let subBlocks = fromMaybe [] (subItems >>= \case (OrderedList items) -> Just (concatMap (\(ListItem bs) -> bs) items); _ -> Nothing)
    return $ ListItem (parsedContent ++ subBlocks)

footnoteReferenceParser :: Parser Block
footnoteReferenceParser = do
    optional inlineSpace
    is '['
    is '^'
    numStr <- some digit
    is ']'
    is ':'
    skipMany (satisfy isSpace)  -- Ignore spaces after colon
    content <- manyTill anyChar (lookAhead eol <|> eof)  -- Capture the content
    let num = read numStr
    return $ FootnoteReference num (trim content)

trim :: String -> String
trim = f . f
  where f = reverse . dropWhile isSpace

paragraphParser :: Parser Block
paragraphParser = do
  notFollowedBy footnoteRefStartParser
  notFollowedBy tableStartParser -- Prevent parsing tables as paragraphs
  notFollowedBy headingStartParser -- Prevent headings being parsed as paragraphs
  contentLine <- inlineContentLine
  return $ Paragraph contentLine

sepByAtLeast2 :: Parser a -> Parser sep -> Parser [a]
sepByAtLeast2 p sep = do
    a <- p
    sep
    b <- p
    rest <- many (sep *> p)
    return (a : b : rest)

tableStartParser :: Parser ()
tableStartParser = lookAhead $ do
    skipMany (satisfy isSpace)
    optional (is '|')
    cells <- sepByAtLeast2 (many (satisfy (\c -> c /= '|' && c /= '\n'))) (is '|')
    optional (is '|')
    eol
    skipMany (satisfy isSpace)
    optional (is '|')
    optional inlineSpace
    c <- satisfy (\c -> c == '-' || c == ':')
    cs <- many (satisfy (\c -> c == '-' || c == ':' || isSpace c))
    optional (is '|')
    return ()

tableParser :: Parser Block
tableParser = try $ do
    skipMany (satisfy isSpace)
    header <- tableRowParser
    separatorRow <- separator
    rows <- many tableRowParser
    return $ Table header rows

separator :: Parser ()
separator = do
    skipMany (satisfy isSpace)
    optional (is '|')
    sepBy1 separatorCell (optional inlineSpace *> is '|' *> optional inlineSpace)
    optional (is '|')
    eol
    return ()

separatorCell :: Parser ()
separatorCell = do
    optional inlineSpace
    many1 (is '-')
    optional inlineSpace
    return ()

sepEndBy1 :: Parser a -> Parser sep -> Parser [a]
sepEndBy1 p sep = do
    first <- p
    rest <- many (sep *> p)
    optional sep
    return (first : rest)

tableRowParser :: Parser TableRow
tableRowParser = do
    skipMany (satisfy isSpace)
    optional (is '|')
    -- Use sepEndBy1 to handle trailing '|'
    cells <- sepEndBy1 cellParser (optional inlineSpace *> is '|' *> optional inlineSpace)
    optional (is '|') -- Optional trailing '|', do not treat as another cell
    eol
    return $ TableRow cells

cellParser :: Parser [Inline]
cellParser = do
    optional inlineSpace
    content <- many (satisfy (\c -> c /= '|' && c /= '\n'))
    optional inlineSpace
    let trimmedContent = trim content
    guard (not (null trimmedContent))
    case parse (inlineContent <* eof) trimmedContent of
        Result _ inlines -> return inlines
        _ -> return [Plain trimmedContent]

-- Inline parsing
inlineContent :: Parser [Inline]
inlineContent = many inlineElement

inlineContentLine :: Parser [Inline]
inlineContentLine = some inlineElement <* (lookAhead (eol <|> eof))  -- Changed from 'manyTill' to 'some'

inlineElement :: Parser Inline
inlineElement = choice
    [ try boldParser
    , try italicParser
    , try strikethroughParser
    , try imageParser
    , try linkParser
    , try inlineCodeParser
    , footnoteParser  -- Moved footnoteParser before plainParser
    , plainParser
    ]

plainParser :: Parser Inline
plainParser = do
    c <- satisfy (\c -> c `notElem` "_*~`[!]^\n\r")
    rest <- many (satisfy (\c -> c `notElem` "_*~`[!]^\n\r"))
    return $ Plain (c:rest)

italicParser :: Parser Inline
italicParser = do
    is '_'
    content <- inlineContentTill (is '_')
    return $ Italic content

boldParser :: Parser Inline
boldParser = do
    string "**"
    content <- inlineContentTill (string "**")
    return $ Bold content

strikethroughParser :: Parser Inline
strikethroughParser = do
    string "~~"
    content <- inlineContentTill (string "~~")
    return $ Strikethrough content

inlineCodeParser :: Parser Inline
inlineCodeParser = do
    is '`'
    content <- many (satisfy (/= '`'))
    is '`'
    return $ InlineCode content

footnoteParser :: Parser Inline
footnoteParser = do
    is '['
    is '^'
    numStr <- some digit
    is ']'
    let num = read numStr
    return $ Footnote num

linkParser :: Parser Inline
linkParser = do
    is '['
    linkText <- inlineContentTill (is ']')
    is ']'
    is '('
    url <- some (satisfy (\c -> not (isSpace c) && c /= ')'))
    _ <- optional (is ' ' *> is '"' *> many (satisfy (/= '"')) <* is '"')
    is ')'
    return $ Link linkText url

spaceNotNewline1 :: Parser ()
spaceNotNewline1 = do
    satisfy (\c -> isSpace c && c /= '\n' && c /= '\r')
    skipMany (satisfy (\c -> isSpace c && c /= '\n' && c /= '\r'))
    return ()

imageParser :: Parser Inline
imageParser = do
    is '!'
    is '['
    altText <- many (satisfy (/= ']'))
    is ']'
    is '('
    url <- some (satisfy (\c -> not (isSpace c) && c /= ')'))
    spaceNotNewline1
    is '"'
    caption <- many (satisfy (/= '"'))
    is '"'
    is ')'
    return $ Image altText url (Just caption)

inlineContentTill :: Parser a -> Parser [Inline]
inlineContentTill end = manyTill inlineElement (try end)

parseInlineContent :: String -> Parser [Inline]
parseInlineContent s = case parse (inlineContent <* eof) s of
    Result _ inlines -> return inlines
    _ -> empty

parseBlocks :: String -> Parser [Block]
parseBlocks s = case parse markdownParser s of
    Result _ (Document blocks) -> return blocks
    _ -> return []
    
-- Convert Inline to Text
inlineToText :: Inline -> String
inlineToText (Plain text) = text
inlineToText (Italic inlines) = concatMap inlineToText inlines
inlineToText (Bold inlines) = concatMap inlineToText inlines
inlineToText (Strikethrough inlines) = concatMap inlineToText inlines
inlineToText (Link inlines _) = concatMap inlineToText inlines
inlineToText (InlineCode text) = text
inlineToText (Footnote n) = show n
inlineToText _ = ""

-- Part B: Conversion between Markdown and HTML
getTime :: IO String
getTime = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" <$> getCurrentTime

convertADTHTML :: ADT -> String
convertADTHTML (Document blocks) =
  "<!DOCTYPE html>\n" ++
  "<html lang=\"en\">\n\n" ++
  "<head>\n" ++
  "    <meta charset=\"UTF-8\">\n" ++
  "    <title>Converted HTML</title>\n" ++
  "</head>\n\n" ++
  "<body>\n" ++
  concatMap convertBlockHTML blocks ++
  "</body>\n\n" ++
  "</html>"

convertBlockHTML :: Block -> String
convertBlockHTML (Heading level inlines) =
  "    <h" ++ show level ++ ">" ++ concatMap convertInlineHTML inlines ++ "</h" ++ show level ++ ">\n"
convertBlockHTML (BlockQuote blocks) =
  "    <blockquote>\n" ++ concatMap convertBlockHTMLIndented blocks ++ "    </blockquote>\n"
convertBlockHTML (CodeBlock mLang code) =
  let classAttr = maybe "" (\lang -> " class=\"language-" ++ lang ++ "\"") mLang
      escapedCode = escapeHTMLCode code
  in "    <pre><code" ++ classAttr ++ ">" ++ escapedCode ++ "</code></pre>\n"
convertBlockHTML (FootnoteReference n text) =
  "    <p id=\"fn" ++ show n ++ "\">" ++ escapeHTML text ++ "</p>\n"
convertBlockHTML (OrderedList items) =
  "    <ol>\n" ++ concatMap convertListItemHTML items ++ "    </ol>\n"
convertBlockHTML (Table header rows) =
    let numColumns = length (tableRowCells header)
    in "    <table>\n" ++
       "        <thead>\n            <tr>\n" ++
       concatMap (\cell -> "                <th>" ++ concatMap convertInlineHTML cell ++ "</th>\n") (tableRowCells header) ++
       "            </tr>\n        </thead>\n" ++
       "        <tbody>\n" ++ concatMap (convertTableRowHTML numColumns) rows ++
       "        </tbody>\n    </table>\n"
convertBlockHTML (Paragraph [Image alt src mTitle]) =
  "    <img src=\"" ++ escapeURL src ++ "\" alt=\"" ++ escapeHTML alt ++ "\"" ++
  maybe "" (\title -> " title=\"" ++ escapeHTML title ++ "\"") mTitle ++ ">\n"
convertBlockHTML (Paragraph inlines) =
  "    <p>" ++ concatMap convertInlineHTML inlines ++ "</p>\n"

convertBlockHTMLIndented :: Block -> String
convertBlockHTMLIndented block = indent (convertBlockHTML block)

convertTableRowHTML :: Int -> TableRow -> String
convertTableRowHTML numColumns (TableRow cells) =
    let cellsToRender = take numColumns cells
    in "            <tr>\n" ++
       concatMap (\cell -> "                <td>" ++ concatMap convertInlineHTML cell ++ "</td>\n") cellsToRender ++
       "            </tr>\n"

tableRowCells :: TableRow -> [[Inline]]
tableRowCells (TableRow cells) = cells

convertListItemHTML :: ListItem -> String
convertListItemHTML (ListItem blocks) =
  "        <li>\n" ++ concatMap convertBlockHTMLIndented blocks ++ "        </li>\n"

convertInlineHTML :: Inline -> String
convertInlineHTML (Plain text) = escapeHTML text
convertInlineHTML (Italic inlines) = "<em>" ++ concatMap convertInlineHTML inlines ++ "</em>"
convertInlineHTML (Bold inlines) = "<strong>" ++ concatMap convertInlineHTML inlines ++ "</strong>"
convertInlineHTML (Strikethrough inlines) = "<del>" ++ concatMap convertInlineHTML inlines ++ "</del>"
convertInlineHTML (Link inlines url) = "<a href=\"" ++ escapeURL url ++ "\">" ++ concatMap convertInlineHTML inlines ++ "</a>"
convertInlineHTML (Image alt src mTitle) =
  "<img src=\"" ++ escapeURL src ++ "\" alt=\"" ++ escapeHTML alt ++ "\"" ++
  maybe "" (\title -> " title=\"" ++ escapeHTML title ++ "\"") mTitle ++ ">"
convertInlineHTML (InlineCode text) = "<code>" ++ escapeHTML text ++ "</code>"
convertInlineHTML (Footnote n) = "<sup><a id=\"fn" ++ show n ++ "ref\" href=\"#fn" ++ show n ++ "\">" ++ show n ++ "</a></sup>"

escapeHTML :: String -> String
escapeHTML = concatMap (\c -> case c of
    '&'  -> "&amp;"
    '<'  -> "&lt;"
    '>'  -> "&gt;"
    '"'  -> "&quot;"
    '\'' -> "&#39;"
    _    -> [c])

escapeHTMLCode :: String -> String
escapeHTMLCode = concatMap (\c -> case c of
    '&' -> "&amp;"
    '<' -> "&lt;"
    '>' -> "&gt;"
    _   -> [c])

escapeURL :: String -> String
escapeURL = escapeHTML -- simplistic, should encode special URL characters

indent :: String -> String
indent = unlines . map ("        " ++) . lines

-- Added notFollowedBy function
-- Correct implementation of notFollowedBy
notFollowedBy :: Parser a -> Parser ()
notFollowedBy pa = Parser $ \input ->
    case parse pa input of
        Result _ _ -> Error (UnexpectedChar (head input))
        Error _    -> Result input () -- Succeeds if 'pa' does not match

-- Defined footnoteRefStartParser
footnoteRefStartParser :: Parser ()
footnoteRefStartParser = do
    optional inlineSpace
    is '['
    is '^'
    some digit
    is ']'
    is ':'
    return ()

-- Added Image Block Parser
imageBlockParser :: Parser Block
imageBlockParser = do
    optional inlineSpace
    img <- imageParser
    optional inlineSpace
    eol <|> eof
    return $ Paragraph [img], simplify the code, make it more efficient , but keep it readable