dead code elimination

This commit is contained in:
Pagwin 2025-11-27 18:55:23 -05:00
parent 499811fed0
commit 5fecacb93e
No known key found for this signature in database
GPG key ID: 81137023740CA260

View file

@ -8,19 +8,16 @@ module Markdown (document, metadata) where
import Control.Applicative (many, optional, some, (<|>))
import Control.Monad (guard, void)
import Data.Char (isAlpha)
import Data.Functor.Identity (Identity)
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import GHC.Stack (HasCallStack, callStack, prettyCallStack)
import IR
import Logger (Logger (logDebug))
import Text.Megaparsec (ParsecT, Stream, Token, Tokens, anySingle, anySingleBut, between, choice, count, eof, manyTill, notFollowedBy, satisfy, skipSome, try, (<?>))
import qualified Text.Megaparsec as MP
import Text.Megaparsec.Char (alphaNumChar, char, digitChar, string)
import Utilities (tee)
type ParserTG = ParsecT Void
@ -28,9 +25,6 @@ type ParserT m = ParserTG T.Text m
type Parser = ParserT Identity
logP :: (Logger m, Show v, Token s ~ Char, Stream s) => ParserTG s m v -> ParserTG s m v
logP = tee (logDebug . T.show)
anyChar :: (Token s ~ Char, Stream s) => ParserTG s m Char
anyChar = anySingle
@ -175,15 +169,6 @@ unorderedListItem = do
children <- many (try indentedList)
pure $ LI content children
listContinuation :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m [InlineText]
listContinuation = do
count 2 (char ' ' <|> char '\t')
many (char ' ' <|> char '\t')
notFollowedBy (oneOf "*-+")
notFollowedBy (digit >> char '.')
content <- manyTill inlineElement (try lineEnding)
pure content
-- TODO: handle list indentation at all levels
indentedList :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m List
indentedList = do
@ -233,32 +218,6 @@ htmlBlock = do
let content = '<' : (rest <> ">")
return $ HTML $ HTMLTag (T.pack content)
tagName :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m String
tagName = do
first <- satisfy isAlpha
rest <- many (alphaNum <|> char '-' <|> char ':')
pure (first : rest)
attribute :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m (Text, Maybe Text)
attribute = do
name <- attributeName
value <- optionMaybe (char '=' >> attributeValue)
pure (T.pack name, fmap T.pack value)
attributeName :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m String
attributeName = do
first <- satisfy isAlpha
rest <- many (alphaNum <|> char '-' <|> char ':')
pure (first : rest)
attributeValue :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m String
attributeValue =
choice
[ between (char '"') (char '"') (many $ anySingleBut '"'),
between (char '\'') (char '\'') (many $ anySingleBut '\''),
some $ noneOf " \t\n\r>\"'=<`"
]
-- Paragraph Block
paragraphBlock :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m Element
paragraphBlock = do
@ -342,7 +301,7 @@ plainTextNo :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => [Cha
plainTextNo list = do
plainTextNo' False list
plainTextNo' :: (HasCallStack, Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => Bool -> [Char] -> ParserTG s m InlineText
plainTextNo' :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => Bool -> [Char] -> ParserTG s m InlineText
plainTextNo' block_whitespace disallow = do
logDebug $ "base plain Text: " <> T.show block_whitespace <> " " <> T.show disallow
firstChar <- noneOf (disallow <> if block_whitespace then " \t\r\n" else []) <?> "Plain Text Initial Disallow"
@ -408,7 +367,7 @@ inlineElementNoBracket =
try codeSpan,
try htmlInline,
try escapedChar,
plainTextNoBracket
plainTextNo "[]"
]
linkDestination :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m (Text, Maybe Text)
@ -461,21 +420,9 @@ plainTextBaseDisallow = "[~`_*<"
plainTextCharNo :: (Logger m, Token s ~ Char, Stream s) => [Char] -> ParserTG s m Char
plainTextCharNo additional = noneOf $ additional <> plainTextBaseDisallow
plainTextNoAsterisk :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m InlineText
plainTextNoAsterisk = plainTextNo "*"
plainTextNoUnderscore :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m InlineText
plainTextNoUnderscore = plainTextNo "_"
plainTextNoBracket :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m InlineText
plainTextNoBracket = plainTextNo "[]"
-- Helper Parsers
lineEnding :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m ()
lineEnding = void (try $ count 2 (try (string "\r\n") <|> try (string "\n") <|> string "\r")) <|> eof
lineEnding' :: (Logger m, Token s ~ Char, Stream s, IsString (Tokens s)) => ParserTG s m ()
lineEnding' = void (try (string "\r\n") <|> try (string "\n") <|> string "\r") <|> eof
wsParser :: (Logger m, Token s ~ Char, Stream s) => ParserTG s m ()
wsParser = void $ some (char ' ' <|> char '\t')