~jleightcap/hhtml

d2020239c517c1c9b5c944eaa598dea1f2b7adef — jleightcap 2 months ago f6e115b main
applicative / fmap in parsing
1 files changed, 25 insertions(+), 31 deletions(-)

M src/Markup/Parse.hs
M src/Markup/Parse.hs => src/Markup/Parse.hs +25 -31
@@ 35,9 35,6 @@ whitespace = void $ many1 $ oneOf " \n\t"
eol :: Parser String
eol = string "\n"

lexeme :: Parser String
lexeme = many1 $ alphaNum

line :: Parser String
line = many1 $ noneOf "\n"



@@ 56,18 53,20 @@ bool = choice [true, false]
config :: Parser Conf
config = do
  void $ string "---\n"
  author <- (try . optionMaybe . configElem line) "author"
  date <- (try . optionMaybe . configElem line) "date"
  readTime <- (try . optionMaybe . configElem line) "read"
  style <- (try . optionMaybe . configElem line) "style"
  title <- configElem line "title"
  contents <- (try . configElem bool) "toc"
  c_author <- (try . optionMaybe . configElem line) "author"
  c_date <- (try . optionMaybe . configElem line) "date"
  c_readTime <- (try . optionMaybe . configElem line) "read"
  c_style <- (try . optionMaybe . configElem line) "style"
  c_title <- configElem line "title"
  c_contents <- (try . configElem bool) "toc"
  void $ string "---\n"
  return $ Conf author date readTime style title contents
  return $ Conf c_author c_date c_readTime c_style c_title c_contents

-- parse between delimiters (delimit "`" "`code`" -> code)
{-
delimit :: String -> String -> Parser String
delimit l r = between (string l) (string r) (many $ noneOf r)
-}

delimit1 :: String -> String -> Parser String
delimit1 l r = between (string l) (string r) (many1 $ noneOf r)


@@ 88,13 87,13 @@ strikeout :: Parser Text
strikeout = Strikeout . format <$> delimit1 "~" "~"

url :: Parser Text
url = Link <$> (fmap format $ delimit1 "[" "]") <*> delimit1 "(" ")"
url = Link <$> (format <$> delimit1 "[" "]") <*> delimit1 "(" ")"

delims :: [Char]
delims = "*_`[]~" -- characters that define inline formatting

plain :: Parser Text
plain = fmap Plain $ many1 $ noneOf delims
plain = Plain <$> (many1 . noneOf) delims

text :: Parser Text
text =


@@ 111,39 110,34 @@ format s =
-- document structure
--
unorderedListItem :: Parser [Text]
unorderedListItem = fmap format $ optional whitespace *> line
unorderedListItem = format <$> (optional whitespace *> line)

unorderedList :: Parser AST
unorderedList =
  fmap UnorderedList $
  string "-" *> unorderedListItem `sepBy` (try $ string "\n-")
  UnorderedList <$>
  (string "-" *> unorderedListItem `sepBy` (try $ string "\n-"))

codeBlock :: Parser AST
codeBlock =
  fmap CodeBlock $ do
    void $ string "```\n"
    manyTill anyToken $ try $ string "\n```"
  CodeBlock <$> do string "```\n" *> (manyTill anyToken . try . string) "\n```"

quote :: Parser AST
quote = fmap Quote $ string ">" *> optional whitespace *> fmap format line
quote = Quote <$> (string ">" *> optional whitespace *> fmap format line)

-- image alt text does not include formatting
img :: Parser AST
img = do
  alt <- between (string "![") (string "]") (many $ noneOf "]")
  fmt <- optionMaybe $ delimit1 "[" "]"
  path <- delimit1 "(" ")"
  return $ Image alt fmt path
img =
  Image <$> (between (string "![") (string "]") (many $ noneOf "]")) <*>
  (optionMaybe $ delimit1 "[" "]") <*>
  (delimit1 "(" ")")

header :: Parser AST
header = do
  hdelims <- many1 $ char '#'
  optional whitespace
  hbody <- line
  return $ Header (length hdelims) (format hbody)
header =
  Header <$> (fmap length $ many1 $ char '#') <* optional whitespace <*>
  (fmap format line)

centerText :: Parser AST
centerText = fmap (CenterText . format) $ delimit1 "{{{" "}}}"
centerText = (CenterText . format) <$> delimit1 "{{{" "}}}"

paragraph :: Parser AST
paragraph =


@@ 165,7 159,7 @@ asts :: Parser [AST]
asts = ast `sepEndBy` eol

document :: Parser Document
document = Document <$> config <*> (fmap condense asts)
document = Document <$> config <*> fmap condense asts

parseWithLeftover :: Parser a -> String -> Either ParseError (a, String)
parseWithLeftover p = parse ((,) <$> p <*> leftOver) ""