diff --git a/.gitignore b/.gitignore index 45c7026..a32d4e5 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ src/Example.mad .DS_Store .coverage .tests +.vscode diff --git a/FIXTURE.md b/FIXTURE.md index bb8c886..457f431 100644 --- a/FIXTURE.md +++ b/FIXTURE.md @@ -10,6 +10,26 @@ ###### are needed +List of stuff: + * spades + * hearts + * clubs + * diamonds + +List of stuff in order: + 1. January + 1. February + 1. March + 1. April + 1. May + 1. June + 1. July + 1. August + 1. September + 1. October + 1. November + 1. December + Impossibly *charming* and _sophisticated_. **Delightfully** jejeune. How __droll__. ```javascript @@ -31,3 +51,8 @@ more more more more text [link](//madlib.biz) And another thing… + +[[internal links are magical]] + +Sometimes you want an [[internal link|with different display text]] +Other times you have text before [[an internal link]] diff --git a/YAML_FIXTURE.yaml b/YAML_FIXTURE.yaml new file mode 100644 index 0000000..8879ff2 --- /dev/null +++ b/YAML_FIXTURE.yaml @@ -0,0 +1,14 @@ +name: Madlib +year: 2020 +functional: true +imperative: # this is an empty field +contributors: + - Brekk + - Arnaud +link: "[[Installation]]" +links: + - "[[The Fence]]" + - "[[Comments]]" +effort: 4.5 +start: 2020-08-27 +starttime: 2020-08-27T08:00:00 diff --git a/madlib.json b/madlib.json index 39b0018..6484103 100644 --- a/madlib.json +++ b/madlib.json @@ -2,7 +2,7 @@ "name": "MadMarkdownParser", "version": "0.0.6", "madlibVersion": "0.23.14", - "main": "src/Main.mad", + "main": "src/MadMarkdownParser.mad", "importAliases": { ".": "src" }, diff --git a/src/Combinators.mad b/src/Combinators.mad new file mode 100644 index 0000000..6d4efbd --- /dev/null +++ b/src/Combinators.mad @@ -0,0 +1,15 @@ +import type { Parser } from "Parse" + +import { apL } from "Applicative" +import { identity } from "Function" +import { mapL } from "Functor" +import { lookAhead, manyTill } from "Parse" + + + +between :: Parser a -> Parser b -> Parser c -> Parser b +export between = (start, mid, end) => pipe( + mapL(identity), + ap($, mid), + apL($, end), +)(start) diff --git a/src/Link.mad b/src/Link.mad new file mode 100644 index 0000000..270b619 --- /dev/null +++ b/src/Link.mad @@ -0,0 +1,30 @@ +import P from "Parse" +import String from "String" + + + +// https://stackoverflow.com/questions/1547899/which-characters-make-a-url-invalid +linkCharacter :: P.Parser Char +export linkCharacter = P.choice([ + P.letter, + P.digit, + P.char('!'), + P.char('#'), + P.char('$'), + P.char('%'), + P.char('&'), + P.char('\''), + P.char('*'), + P.char('+'), + P.char(','), + P.char('-'), + P.char('.'), + P.char('/'), + P.char(':'), + P.char(';'), + P.char('='), + P.char('?'), + P.char('@'), + P.char('_'), + P.char('~'), +]) diff --git a/src/MadMarkdownParser.mad b/src/MadMarkdownParser.mad new file mode 100644 index 0000000..c8b0d6a --- /dev/null +++ b/src/MadMarkdownParser.mad @@ -0,0 +1,423 @@ +import type { Either } from "Either" +import type { Maybe } from "Maybe" + +import type { YamlData, YamlPair } from "@/Yaml" +import type { YamlValue } from "@/Yaml" + +import { apL } from "Applicative" +import { mapLeft } from "Either" +import { always, equals, identity } from "Function" +import { mapL } from "Functor" +import IO from "IO" +import { dropWhile, mapMaybe } from "List" +import { Just, Nothing } from "Maybe" +import P from "Parse" +import String from "String" + +import { between } from "@/Combinators" +import { linkCharacter } from "@/Link" +import { NOTHING, SPACE, blank, end, singleReturnTerminal } from "@/Shared" +import { markYaml } from "@/Yaml" + + + +export type ContentPart + = Text(String) + | Bold(String) + | Italic(String) + | InlineCode(String) + | Link(String, String) + | InternalLink(String, String) + | Image(String, String) + | Yaml(Dictionary String YamlValue) + | LineReturn + +export alias Content = List ContentPart + +export type Block + = H1(Content) + | H2(Content) + | H3(Content) + | H4(Content) + | H5(Content) + | H6(Content) + | Paragraph(Content) + | Blockquote(Content) + | Code(String, String) + | UnorderedList(List Content) + | OrderedList(List Content) + | YamlBlock(Content) + + +export alias Markdown = List Block + + +boldDelimiter = P.choice([P.string("**"), P.string("__")]) + +bold :: P.Parser ContentPart +export bold = pipe( + mapL(Bold), + ap( + $, + pipe( + (a) => P.someTill(a, P.lookAhead(boldDelimiter)), + map(String.fromList), + )(P.notChar('\n')), + ), + apL($, boldDelimiter), +)(boldDelimiter) + +italicDelimiter = P.choice([P.char('*'), P.char('_')]) + +italic :: P.Parser ContentPart +export italic = do { + _ <- italicDelimiter + firstChar <- P.notChar(' ') + nextChars <- P.many(P.notOneOf(['_', '*', '\n'])) + _ <- italicDelimiter + + return pipe( + String.fromList, + Italic, + of, + )([firstChar, ...nextChars]) +} + +// https://help.obsidian.md/Linking+notes+and+files/Internal+links +// [[01 - Hello mad, mad world#Installation|Installing]] +internalLinkWithDisplay :: P.Parser ContentPart +export internalLinkWithDisplay = do { + _ <- P.string("[[") + url <- pipe( + P.many, + map(String.fromList), + )(linkCharacter) + _ <- P.char('|') + displayText <- pipe( + P.manyTill(P.letter), + map(String.fromList), + )(P.string("]]")) + _ <- P.string("]]") + return pipe( + InternalLink(displayText), + of, + )(url) +} + +// [[02 - Cool data for lyfe]] +shortInternalLink :: P.Parser ContentPart +export shortInternalLink = do { + _ <- P.string("[[") + ref <- pipe( + P.manyTill(P.letter), + map(String.fromList), + )(P.string("]]")) + _ <- P.string("]]") + return pipe( + InternalLink(ref), + of, + )(ref) +} + +internalLink :: P.Parser ContentPart +export internalLink = P.choice([shortInternalLink, internalLinkWithDisplay]) + +inlineCode :: P.Parser ContentPart +export inlineCode = pipe( + mapL(InlineCode), + ap( + $, + pipe( + P.many, + map(String.fromList), + )(P.notOneOf(['`', '\n'])), + ), + apL($, P.char('`')), +)(P.char('`')) + +link :: P.Parser ContentPart +export link = pipe( + map(Link), + ap( + $, + between( + P.char('('), + pipe( + P.many, + map(String.fromList), + )(linkCharacter), + P.char(')'), + ), + ), +)( + between( + P.char('['), + pipe( + P.many, + map(String.fromList), + )(P.notOneOf([']', '\n'])), + P.char(']'), + ), +) + +image :: P.Parser ContentPart +export image = pipe( + mapL(Image), + ap( + $, + between( + P.char('['), + pipe( + P.many, + map(String.fromList), + )(P.notOneOf([']', '\n'])), + P.char(']'), + ), + ), + ap( + $, + between( + P.char('('), + pipe( + P.many, + map(String.fromList), + )(linkCharacter), + P.char(')'), + ), + ), +)(P.char('!')) + +textTerminals :: P.Parser String +export textTerminals = P.choice([ + blank(internalLink), + blank(bold), + blank(italic), + blank(inlineCode), + blank(image), + blank(link), + end, + P.string("\n"), +]) + +text :: P.Parser ContentPart +export text = pipe( + P.someTill($, P.lookAhead(textTerminals)), + map( + pipe( + String.fromList, + Text, + ), + ), +)(P.notChar('\n')) + +lineReturn :: P.Parser ContentPart +export lineReturn = map(always(LineReturn), P.char('\n')) + +yaml :: P.Parser ContentPart +yaml = do { + data <- markYaml + return pipe( + Yaml, + of, + )(data) +} + +contentPart :: P.Parser ContentPart +contentPart = P.choice([yaml, internalLink, bold, italic, inlineCode, image, link, text]) + +content :: P.Parser Content +export content = P.many(contentPart) + +coerceEmpty :: Maybe a -> P.Parser ContentPart +export coerceEmpty = pipe( + where { + Just(_) => + aempty + + Nothing => + lineReturn + }, +) + +lineReturnExceptBefore :: P.Parser a -> P.Parser ContentPart +export lineReturnExceptBefore = (before) => pipe( + mapL(identity), + ap($, alt(map(always(Just({})), before), pure(Nothing))), + P.lookAhead, + chain(coerceEmpty), +)(lineReturn) + +contentWithLineReturn :: P.Parser a -> P.Parser Content +export contentWithLineReturn = (delimiter) => pipe( + P.choice, + P.some, + map(dropWhile(equals(LineReturn))), +)([ + yaml, + internalLink, + bold, + italic, + inlineCode, + image, + link, + text, + lineReturnExceptBefore(delimiter), +]) + +heading :: (Content -> Block) -> String -> P.Parser Block +export heading = (constructor) => pipe( + P.symbol, + mapL(constructor), + ap($, content), + apL($, singleReturnTerminal), +) + + +doubleReturnTerminal :: P.Parser String +export doubleReturnTerminal = P.choice([ + P.string("\n\n"), + end, + pipe( + ap(pure((_, _) => "")), + ap($, P.eof), + )(P.char('\n')), +]) + +code :: P.Parser Block +export code = pipe( + mapL(Code), + ap($, alt(map(String.fromList, P.letters), pure(""))), + apL($, P.char('\n')), + ap($, map(String.fromList, P.manyTill(P.anyChar, P.lookAhead(P.string("\n```"))))), + apL($, P.choice([map((_) => "", apL(P.string("\n```"), P.eof)), P.string("\n```\n")])), +)(P.string("```")) + +blockquote :: P.Parser Block +export blockquote = pipe( + mapL(Blockquote), + ap($, contentWithLineReturn(P.choice([P.string("\n"), P.string("```"), P.string(">")]))), + apL( + $, + P.choice([doubleReturnTerminal, P.lookAhead(P.string("\n```")), P.lookAhead(P.string("\n>"))]), + ), +)(alt(P.symbol(">"), P.string(">"))) + +listItemStart :: P.Parser a -> P.Parser Content +export listItemStart = (starter) => pipe( + chain(always(apL(content, singleReturnTerminal))), +)(starter) + +// export olistItemStart = blank( +// apL(P.many(SPACE), apL(P.someTill(P.digit, P.lookAhead(P.char('.'))), P.some(SPACE))), +// ) + +export olistItemStart = do { + space <- P.some(P.char(' ')) + digits <- P.token(P.some(P.digit)) + dot <- P.char('.') + return pipe( + of, + )("") +} + +// orderedListItem :: P.Parser Content +// export orderedListItem = listItemStart(olistItemStart) + +/* +export orderedList = pipe( + P.some, + map(OrderedList), +)(orderedListItem) +*/ + +// the crap in olistItemStart above squeezes out the spaces +// so we need to do that in the morning +export orderedListItem = do { + _ <- P.some(P.char(' ')) <|> pure([]) + _ <- P.token(P.some(P.digit)) + _ <- P.symbol(".") <|> pure("") + lineContent <- P.token(content) + _ <- P.symbol("\n") <|> pure("") + return pipe( + of, + )(lineContent) +} +export orderedList = do { + items <- P.sepBy(orderedListItem, P.token(P.char('\n'))) + IO.pTrace("ITEMS!", items) + return pipe( + OrderedList, + of, + )([...items]) +} + +export ulistItemStart = blank(apL(P.many(SPACE), apL(P.oneOf(['*', '-', '+']), P.some(SPACE)))) + +unorderedListItem :: P.Parser Content +export unorderedListItem = listItemStart(ulistItemStart) + +unorderedList :: P.Parser Block +export unorderedList = pipe( + P.some, + map(UnorderedList), +)(unorderedListItem) + +markdownList :: P.Parser Block +export markdownList = P.choice([orderedList, unorderedList]) + +paragraph :: P.Parser Block +export paragraph = pipe( + map(Paragraph), + apL( + $, + P.choice([ + doubleReturnTerminal, + P.lookAhead(P.string("\n```")), + P.lookAhead(P.string("\n>")), + P.lookAhead(apL(P.string("\n"), olistItemStart)), + P.lookAhead(apL(P.string("\n"), ulistItemStart)), + ]), + ), +)( + contentWithLineReturn( + P.choice([P.string("\n"), P.string("```"), P.string(">"), olistItemStart, ulistItemStart]), + ), +) + +yamlBlock :: P.Parser Block +export yamlBlock = do { + parsed <- yaml + return pipe( + of, + YamlBlock, + of, + )(parsed) +} + +block :: P.Parser Block +export block = P.choice([ + heading(H6, "######"), + heading(H5, "#####"), + heading(H4, "####"), + heading(H3, "###"), + heading(H2, "##"), + heading(H1, "#"), + markdownList, + blockquote, + code, + paragraph, + yamlBlock, +]) + +markdownParser :: P.Parser Markdown +export markdownParser = pipe( + P.choice, + P.many, + map(mapMaybe(identity)), +)([map(always(Nothing), P.spaces), map(Just, block)]) + +parseMarkdown :: String -> Either String Markdown +export parseMarkdown = pipe( + P.runParser(markdownParser), + mapLeft(always("Malformed markdown input")), +) diff --git a/src/MadMarkdownParser.spec.mad b/src/MadMarkdownParser.spec.mad new file mode 100644 index 0000000..0b57608 --- /dev/null +++ b/src/MadMarkdownParser.spec.mad @@ -0,0 +1,313 @@ +import { Left, Right } from "Either" +import File from "File" +import { always } from "Function" +import IO from "IO" +import P from "Parse" +import Parse from "Parse" +import Test from "Test" +import Wish from "Wish" + +import { + Blockquote, + Bold, + Code, + H1, + H2, + H3, + H4, + H5, + H6, + Image, + InlineCode, + InternalLink, + Italic, + LineReturn, + Link, + OrderedList, + Paragraph, + Text, + UnorderedList, + block, + blockquote, + bold, + code, + coerceEmpty, + content, + contentWithLineReturn, + doubleReturnTerminal, + heading, + image, + inlineCode, + internalLink, + italic, + lineReturn, + lineReturnExceptBefore, + link, + listItemStart, + markdownParser, + olistItemStart, + orderedList, + orderedListItem, + paragraph, + parseMarkdown, + text, + textTerminals, + ulistItemStart, + unorderedList, + unorderedListItem, +} from "./MadMarkdownParser" +import { linkCharacter } from "@/Link" +import { parseTest, testParser } from "@/Test" + + + +assertEquals = Test.assertEquals +test = Test.test +TestError = Test.Error + +test( + "ulistItemStart", + () => do { + _ <- testParser(ulistItemStart, " * ", "") + return testParser(ulistItemStart, " * ", "") + }, +) +/* +test( + "olistItemStart", + () => do { + _ <- testParser(olistItemStart, "1.", "") + return testParser(olistItemStart, "2021.", "") + }, +) +// */ +/* +test( + "orderedList", + () => do { + return testParser( + orderedList, + ` 1. hey + 2. every`, + OrderedList([]), + ) + }, +) +// */ +parseTest("orderedListItem", orderedListItem, " 2. cool", [Text("cool")]) + +test( + "smoke testing", + () => do { + digits = P.some(P.digit) + _ <- testParser(map(always("digimon"), digits), "102932092", "digimon") + _ <- testParser(map(always("digimon many"), P.many(P.digit)), "102932092", "digimon many") + _ <- testParser(map(always("period!"), P.char('.')), ".", "period!") + _ <- testParser(map(always(""), digits), "1", "") + // this fails to parse + // _ <- testParser(map(always(""), numdot), "1.", "") + // _ <- testParser(map(always(""), numdot), "93031.", "") + return testParser(map(always(""), digits), "1", "") + }, +) + +test( + "linkCharacter", + () => do { + charTest = testParser(linkCharacter) + _ <- charTest("a", 'a') + _ <- charTest("1", '1') + _ <- charTest("!", '!') + _ <- charTest("#", '#') + _ <- charTest("$", '$') + _ <- charTest("%", '%') + _ <- charTest("&", '&') + _ <- charTest("'", '\'') + _ <- charTest("*", '*') + _ <- charTest("+", '+') + _ <- charTest(",", ',') + _ <- charTest("-", '-') + _ <- charTest(".", '.') + _ <- charTest("/", '/') + _ <- charTest(":", ':') + _ <- charTest(";", ';') + _ <- charTest("=", '=') + _ <- charTest("?", '?') + _ <- charTest("@", '@') + _ <- charTest("_", '_') + return charTest("~", '~') + }, +) +/* +parseTest( + "orderedList", + orderedList, + ` 1. Omar + 2. Marlo + 3. Snoop`, + OrderedList([[Text("Hooray")], [Text("Nice")], [Text("Dope")]]), +) +*/ + +parseTest( + "unorderedList", + unorderedList, + ` * a + * b + * c`, + UnorderedList([[Text("a")], [Text("b")], [Text("c")]]), +) + +test( + "internalLink", + () => do { + _ <- testParser(internalLink, "[[xyz|abc]]", InternalLink("abc", "xyz")) + return testParser(internalLink, "[[xyz]]", InternalLink("xyz", "xyz")) + }, +) + +parseTest("block", block, "# hey", H1([Text("hey")])) + +parseTest("*italic*", italic, "*Firenze*", Italic("Firenze")) +parseTest("_italic_", italic, "_Venezia_", Italic("Venezia")) +parseTest("**bold**", bold, "**asterisk**", Bold("asterisk")) +parseTest("__bold__", bold, "__underscore__", Bold("underscore")) + +parseTest("image", image, "![description](//image.biz)", Image("description", "//image.biz")) + +parseTest("link", link, "[madlib](https://madlib.space)", Link("madlib", "https://madlib.space")) + + +parseTest("textTerminals", textTerminals, "*x*", "") +parseTest("text", text, "hooray", Text("hooray")) +parseTest("lineReturn", lineReturn, "\n", LineReturn) +test( + "content", + () => testParser( + content, + "text *italic* **bold** `code` ![ref](domain) [link](domain)", + [ + Text("text "), + Italic("italic"), + Text(" "), + Bold("bold"), + Text(" "), + InlineCode("code"), + Text(" "), + Image("ref", "domain"), + Text(" "), + Link("link", "domain"), + ], + ), +) + +test( + "contentWithLineReturn", + () => testParser( + contentWithLineReturn(Parse.char('^')), + "^\n\n", + [Text("^"), LineReturn, LineReturn], + ), +) + +test("doubleReturnTerminal - newnew", () => testParser(doubleReturnTerminal, "\n\n", "\n\n")) +test("doubleReturnTerminal - eof", () => testParser(doubleReturnTerminal, "", "")) +test("doubleReturnTerminal - new", () => testParser(doubleReturnTerminal, "\n", "")) + +PARSED_FIXTURE = [ + H1([Text("this is a fixture")]), + H2([Text("sometimes")]), + H3([Text("lots")]), + H4([Text("of")]), + H5([Text("headers")]), + H6([Text("are needed")]), + Paragraph([ + Text("Impossibly "), + Italic("charming"), + Text(" and "), + Italic("sophisticated"), + Text(". "), + Bold("Delightfully"), + Text(" jejeune. How "), + Bold("droll"), + Text("."), + ]), + Code( + "javascript", + "\nI once had a dream\n* where\n* I called\n* it\n* javavascurpies\n\n\nmore more more more text\n", + ), + Blockquote([Text("This is a blockquote.")]), + Paragraph([Link("link", "//madlib.biz")]), + Paragraph([Text("And another thing…")]), + Paragraph([InternalLink("internal links are magical", "internal links are magical")]), + Paragraph([ + Text("Sometimes you want an "), + InternalLink("with different display text", "internal link"), + LineReturn, + Text("Other times you have text before "), + InternalLink("an internal link", "an internal link"), + LineReturn, + ]), +] + +/* +test( + "markdownParser", + () => pipe( + File.read, + Wish.mapRej(always(TestError("barf"))), + chain((FIXTURE) => testParser(markdownParser, FIXTURE, PARSED_FIXTURE)), + )("./FIXTURE.md"), +) + +test( + "parseMarkdown", + () => pipe( + File.read, + Wish.mapRej(always(TestError("barf"))), + chain( + pipe( + parseMarkdown, + where { + Left(x) => + pipe( + show, + TestError, + Wish.bad, + )(x) + + Right(res) => + assertEquals(res, PARSED_FIXTURE) + }, + ), + ), + )("./FIXTURE.md"), +) +// / * +test( + "parseMarkdown on real example file", + () => pipe( + File.read, + Wish.mapRej(always(TestError("barf"))), + chain( + pipe( + parseMarkdown, + where { + Left(x) => + pipe( + show, + TestError, + Wish.bad, + )(x) + + Right(res) => + assertEquals(res, []) + }, + ), + ), + )("./notes/Reference/The Fence.md"), +) +// */ + + +test("inlineCode", () => testParser(inlineCode, "`() => {}`", InlineCode("() => {}"))) diff --git a/src/Main.mad b/src/Main.mad index b097161..6400bae 100644 --- a/src/Main.mad +++ b/src/Main.mad @@ -1,347 +1,30 @@ -import type { Either } from "Either" -import type { Maybe } from "Maybe" +import { Left, Right } from "Either" +import File from "File" +import { always } from "Function" +import IO from "IO" +import Parse from "Parse" +import Wish from "Wish" -import { apL } from "Applicative" -import { mapLeft } from "Either" -import { always, equals, identity } from "Function" -import { mapL } from "Functor" -import { dropWhile, mapMaybe } from "List" -import { Just, Nothing } from "Maybe" -import P from "Parse" -import String from "String" +import { yamlContent } from "@/Yaml" -export type ContentPart - = Text(String) - | Bold(String) - | Italic(String) - | InlineCode(String) - | Link(String, String) - | InternalLink(String, String) - | Image(String, String) - | LineReturn - -export alias Content = List ContentPart - -export type Block - = H1(Content) - | H2(Content) - | H3(Content) - | H4(Content) - | H5(Content) - | H6(Content) - | Paragraph(Content) - | Blockquote(Content) - | Code(String, String) - | UnorderedList(List Content) - -export alias Markdown = List Block - -between :: P.Parser a -> P.Parser b -> P.Parser c -> P.Parser b -export between = (start, mid, end) => pipe( - mapL(identity), - ap($, mid), - apL($, end), -)(start) - -// https://stackoverflow.com/questions/1547899/which-characters-make-a-url-invalid -linkCharacter :: P.Parser Char -export linkCharacter = P.choice([ - P.letter, - P.digit, - P.char('!'), - P.char('#'), - P.char('$'), - P.char('%'), - P.char('&'), - P.char('\''), - P.char('*'), - P.char('+'), - P.char(','), - P.char('-'), - P.char('.'), - P.char('/'), - P.char(':'), - P.char(';'), - P.char('='), - P.char('?'), - P.char('@'), - P.char('_'), - P.char('~'), -]) - - - -boldDelimiter = P.choice([P.string("**"), P.string("__")]) - -bold :: P.Parser ContentPart -export bold = pipe( - mapL(Bold), - ap( - $, - pipe( - (a) => P.someTill(a, P.lookAhead(boldDelimiter)), - map(String.fromList), - )(P.notChar('\n')), - ), - apL($, boldDelimiter), -)(boldDelimiter) - -italicDelimiter = P.choice([P.char('*'), P.char('_')]) - -italic :: P.Parser ContentPart -export italic = do { - _ <- italicDelimiter - firstChar <- P.notChar(' ') - nextChars <- P.many(P.notOneOf(['_', '*', '\n'])) - _ <- italicDelimiter - - return pipe( - String.fromList, - Italic, - of, - )([firstChar, ...nextChars]) -} - -// https://help.obsidian.md/Linking+notes+and+files/Internal+links -// [[01 - Hello mad, mad world#Installation|Installing]] -internalLink :: P.Parser ContentPart -export internalLink = do { - _ <- P.string("[[") - url <- pipe( - P.many, - map(String.fromList), - )(linkCharacter) - _ <- P.char('|') - displayText <- pipe( - P.manyTill(P.letter), - map(String.fromList), - )(P.string("]]")) - _ <- P.string("]]") - return pipe( - InternalLink(displayText), - of, - )(url) -} - -inlineCode :: P.Parser ContentPart -export inlineCode = pipe( - mapL(InlineCode), - ap( - $, - pipe( - P.many, - map(String.fromList), - )(P.notOneOf(['`', '\n'])), - ), - apL($, P.char('`')), -)(P.char('`')) - -link :: P.Parser ContentPart -export link = pipe( - map(Link), - ap( - $, - between( - P.char('('), - pipe( - P.many, - map(String.fromList), - )(linkCharacter), - P.char(')'), - ), - ), -)( - between( - P.char('['), - pipe( - P.many, - map(String.fromList), - )(P.notOneOf([']', '\n'])), - P.char(']'), - ), -) - -image :: P.Parser ContentPart -export image = pipe( - mapL(Image), - ap( - $, - between( - P.char('['), - pipe( - P.many, - map(String.fromList), - )(P.notOneOf([']', '\n'])), - P.char(']'), - ), - ), - ap( - $, - between( - P.char('('), +main = () => { + pipe( + File.read, + Wish.mapRej(always("Reading is hard!")), + chain( pipe( - P.many, - map(String.fromList), - )(linkCharacter), - P.char(')'), - ), - ), -)(P.char('!')) - -textTerminals :: P.Parser String -export textTerminals = P.choice([ - map(always(""), bold), - map(always(""), italic), - map(always(""), inlineCode), - map(always(""), image), - map(always(""), link), - map(always(""), P.eof), - P.string("\n"), -]) - -text :: P.Parser ContentPart -export text = pipe( - P.someTill($, P.lookAhead(textTerminals)), - map( - pipe( - String.fromList, - Text, + Parse.runParser(yamlContent), + where { + Left(Parse.Error(Parse.Loc(abs, line, col))) => + Wish.bad(`Parsing is hard! (${show(abs)}, ${show(line)}, ${show(col)})`) + + Right(raw) => + Wish.good(raw) + }, + ), ), - ), -)(P.notChar('\n')) - -lineReturn :: P.Parser ContentPart -export lineReturn = map(always(LineReturn), P.char('\n')) - -content :: P.Parser Content -export content = pipe( - P.choice, - P.many, -)([bold, italic, inlineCode, image, link, text]) - -coerceEmpty :: Maybe a -> P.Parser ContentPart -export coerceEmpty = pipe( - where { - Just(_) => - aempty - - Nothing => - lineReturn - }, -) - -lineReturnExceptBefore :: P.Parser a -> P.Parser ContentPart -export lineReturnExceptBefore = (before) => pipe( - mapL(identity), - ap($, alt(map(always(Just({})), before), pure(Nothing))), - P.lookAhead, - chain(coerceEmpty), -)(lineReturn) - -contentWithLineReturn :: P.Parser a -> P.Parser Content -export contentWithLineReturn = (delimiter) => pipe( - P.choice, - P.some, - map(dropWhile(equals(LineReturn))), -)([bold, italic, inlineCode, image, link, text, lineReturnExceptBefore(delimiter)]) - -heading :: (Content -> Block) -> String -> P.Parser Block -export heading = (constructor) => pipe( - P.symbol, - mapL(constructor), - ap($, content), - apL($, singleReturnTerminal), -) - -singleReturnTerminal :: P.Parser String -export singleReturnTerminal = alt(P.string("\n"), map(always(""), P.eof)) - -doubleReturnTerminal :: P.Parser String -export doubleReturnTerminal = P.choice([ - P.string("\n\n"), - map(always(""), P.eof), - pipe( - ap(pure((_, _) => "")), - ap($, P.eof), - )(P.char('\n')), -]) - -code :: P.Parser Block -export code = pipe( - mapL((lang, c) => Code(lang, c)), - ap($, alt(map(String.fromList, P.letters), pure(""))), - apL($, P.char('\n')), - ap($, map(String.fromList, P.manyTill(P.anyChar, P.lookAhead(P.string("\n```"))))), - apL($, P.choice([map((_) => "", apL(P.string("\n```"), P.eof)), P.string("\n```\n")])), -)(P.string("```")) - -blockquote :: P.Parser Block -export blockquote = pipe( - mapL(Blockquote), - ap($, contentWithLineReturn(P.choice([P.string("\n"), P.string("```"), P.string(">")]))), - apL( - $, - P.choice([doubleReturnTerminal, P.lookAhead(P.string("\n```")), P.lookAhead(P.string("\n>"))]), - ), -)(alt(P.symbol(">"), P.string(">"))) - - -export listItemStart = map( - always(""), - apL(P.many(P.char(' ')), apL(P.oneOf(['*', '-', '+']), P.some(P.char(' ')))), -) - -unorderedListItem :: P.Parser Content -export unorderedListItem = pipe( - chain(always(apL(content, singleReturnTerminal))), -)(listItemStart) - -unorderedList :: P.Parser Block -export unorderedList = pipe( - P.some, - map(UnorderedList), -)(unorderedListItem) - - -paragraph :: P.Parser Block -export paragraph = pipe( - map(Paragraph), - apL( - $, - P.choice([ - doubleReturnTerminal, - P.lookAhead(P.string("\n```")), - P.lookAhead(P.string("\n>")), - P.lookAhead(apL(P.string("\n"), listItemStart)), - ]), - ), -)(contentWithLineReturn(P.choice([listItemStart, P.string("\n"), P.string("```"), P.string(">")]))) - -block :: P.Parser Block -export block = P.choice([ - heading(H6, "######"), - heading(H5, "#####"), - heading(H4, "####"), - heading(H3, "###"), - heading(H2, "##"), - heading(H1, "#"), - unorderedList, - blockquote, - code, - paragraph, -]) - -markdownParser :: P.Parser Markdown -export markdownParser = pipe( - P.choice, - P.many, - map(mapMaybe((x) => x)), -)([map(always(Nothing), P.spaces), map(Just, block)]) - -parseMarkdown :: String -> Either String Markdown -export parseMarkdown = pipe( - P.runParser(markdownParser), - mapLeft(always("Malformed markdown input")), -) + Wish.fulfill((e) => { IO.pTrace("error", e) }, (x) => { IO.pTrace("success", x) }), + )("./YAML_FIXTURE.yaml") +} diff --git a/src/Main.spec.mad b/src/Main.spec.mad deleted file mode 100644 index 13dba3e..0000000 --- a/src/Main.spec.mad +++ /dev/null @@ -1,243 +0,0 @@ -import type { Wish } from "Wish" - -import { Left, Right } from "Either" -import File from "File" -import { always } from "Function" -import { Just, Nothing } from "Maybe" -import Parse from "Parse" -import Test from "Test" -import Wish from "Wish" - - - -assertEquals = Test.assertEquals -test = Test.test -TestError = Test.Error -ParseError = Parse.Error - -import { - Blockquote, - Bold, - Code, - H1, - H2, - H3, - H4, - H5, - H6, - Image, - InlineCode, - InternalLink, - Italic, - LineReturn, - Link, - Paragraph, - Text, - between, - block, - blockquote, - bold, - code, - coerceEmpty, - content, - contentWithLineReturn, - doubleReturnTerminal, - heading, - image, - inlineCode, - internalLink, - italic, - lineReturn, - lineReturnExceptBefore, - link, - linkCharacter, - listItemStart, - markdownParser, - paragraph, - parseMarkdown, - singleReturnTerminal, - text, - textTerminals, - unorderedList, - unorderedListItem, -} from "./Main" - - - -testParser :: (Show a, Eq a) => Parse.Parser a -> String -> a -> Wish Test.AssertionError {} -testParser = (parser, toParse, expected) => pipe( - Parse.runParser(parser), - where { - Left(Parse.Error(Parse.Loc(a, b, c))) => - Wish.bad(TestError(`Error during parsing ${show(a)} ${show(b)} ${show(c)}`)) - - Right(res) => - assertEquals(res, expected) - }, -)(toParse) - -/* -test( - "parseMarkdown", - () => pipe( - parseMarkdown, - where { - Left(x) => - Wish.bad(TestError(x)) - - Right(y) => - assertEquals(y, []) - }, - )("`````"), -) -*/ - -test( - "linkCharacter", - () => do { - _ <- testParser(linkCharacter, "a", 'a') - _ <- testParser(linkCharacter, "1", '1') - _ <- testParser(linkCharacter, "!", '!') - _ <- testParser(linkCharacter, "#", '#') - _ <- testParser(linkCharacter, "$", '$') - _ <- testParser(linkCharacter, "%", '%') - _ <- testParser(linkCharacter, "&", '&') - _ <- testParser(linkCharacter, "'", '\'') - _ <- testParser(linkCharacter, "*", '*') - _ <- testParser(linkCharacter, "+", '+') - _ <- testParser(linkCharacter, ",", ',') - _ <- testParser(linkCharacter, "-", '-') - _ <- testParser(linkCharacter, ".", '.') - _ <- testParser(linkCharacter, "/", '/') - _ <- testParser(linkCharacter, ":", ':') - _ <- testParser(linkCharacter, ";", ';') - _ <- testParser(linkCharacter, "=", '=') - _ <- testParser(linkCharacter, "?", '?') - _ <- testParser(linkCharacter, "@", '@') - _ <- testParser(linkCharacter, "_", '_') - return testParser(linkCharacter, "~", '~') - }, -) - -test("block", () => testParser(block, "# hey", H1([Text("hey")]))) - -test("*italic*", () => testParser(italic, "*Firenze*", Italic("Firenze"))) -test("_italic_", () => testParser(italic, "_Venezia_", Italic("Venezia"))) -test("**bold**", () => testParser(bold, "**asterisk**", Bold("asterisk"))) -test("__bold__", () => testParser(bold, "__underscore__", Bold("underscore"))) - -test("inlineCode", () => testParser(inlineCode, "`() => {}`", InlineCode("() => {}"))) -test( - "image", - () => testParser(image, "![description](//image.biz)", Image("description", "//image.biz")), -) - -test( - "link", - () => testParser(link, "[madlib](https://madlib.space)", Link("madlib", "https://madlib.space")), -) - -test( - "internalLink", - () => testParser( - internalLink, - "[[https://madlib.space|madlib]]", - InternalLink("madlib", "https://madlib.space"), - ), -) - -test("textTerminals", () => testParser(textTerminals, "*x*", "")) -test("text", () => testParser(text, "hooray", Text("hooray"))) -test("lineReturn", () => testParser(lineReturn, "\n", LineReturn)) -test( - "content", - () => testParser( - content, - "text *italic* **bold** `code` ![ref](domain) [link](domain)", - [ - Text("text "), - Italic("italic"), - Text(" "), - Bold("bold"), - Text(" "), - InlineCode("code"), - Text(" "), - Image("ref", "domain"), - Text(" "), - Link("link", "domain"), - ], - ), -) - -test( - "contentWithLineReturn", - () => testParser( - contentWithLineReturn(Parse.char('^')), - "^\n\n", - [Text("^"), LineReturn, LineReturn], - ), -) - -test("doubleReturnTerminal - newnew", () => testParser(doubleReturnTerminal, "\n\n", "\n\n")) -test("doubleReturnTerminal - eof", () => testParser(doubleReturnTerminal, "", "")) -test("doubleReturnTerminal - new", () => testParser(doubleReturnTerminal, "\n", "")) - -PARSED_FIXTURE = [ - H1([Text("this is a fixture")]), - H2([Text("sometimes")]), - H3([Text("lots")]), - H4([Text("of")]), - H5([Text("headers")]), - H6([Text("are needed")]), - Paragraph([ - Text("Impossibly "), - Italic("charming"), - Text(" and "), - Italic("sophisticated"), - Text(". "), - Bold("Delightfully"), - Text(" jejeune. How "), - Bold("droll"), - Text("."), - ]), - Code( - "javascript", - "\nI once had a dream\n* where\n* I called\n* it\n* javavascurpies\n\n\nmore more more more text\n", - ), - Blockquote([Text("This is a blockquote.")]), - Paragraph([Link("link", "//madlib.biz")]), - Paragraph([Text("And another thing…"), LineReturn]), -] - -test( - "markdownParser", - () => pipe( - File.read, - Wish.mapRej(always(TestError("barf"))), - chain((FIXTURE) => testParser(markdownParser, FIXTURE, PARSED_FIXTURE)), - )("./FIXTURE.md"), -) - -test( - "parseMarkdown", - () => pipe( - File.read, - Wish.mapRej(always(TestError("barf"))), - chain( - pipe( - parseMarkdown, - where { - Left(x) => - pipe( - show, - TestError, - Wish.bad, - )(x) - - Right(res) => - assertEquals(res, PARSED_FIXTURE) - }, - ), - ), - )("./FIXTURE.md"), -) diff --git a/src/Shared.mad b/src/Shared.mad new file mode 100644 index 0000000..b9ef44c --- /dev/null +++ b/src/Shared.mad @@ -0,0 +1,18 @@ +import { always } from "Function" +import {} from "Functor" +import P from "Parse" + + + +export NOTHING = always("") +export blank = map(NOTHING) +export end = blank(P.eof) +export lineEnd = P.choice([end, blank(P.char('\n'))]) + +export SPACE = P.char(' ') + +singleReturnTerminal :: P.Parser String +export singleReturnTerminal = alt(P.string("\n"), end) + +maybeMinus :: P.Parser (List Char) +export maybeMinus = map(of, P.char('-')) <|> pure([]) diff --git a/src/Test.mad b/src/Test.mad new file mode 100644 index 0000000..5070d9e --- /dev/null +++ b/src/Test.mad @@ -0,0 +1,49 @@ +import { Left, Right } from "Either" +import File from "File" +import { always } from "Function" +import IO from "IO" +import Parse from "Parse" +import Test from "Test" +import Wish from "Wish" + + + +TestError = Test.Error + +testParser :: (Show a, Eq a) => Parse.Parser a -> String -> a -> Wish Test.AssertionError {} +export testParser = (parser, toParse, expected) => pipe( + Parse.runParser(parser), + where { + Left(Parse.Error(Parse.Loc(a, b, c))) => + Wish.bad(TestError(`Error during parsing ${show(a)} ${show(b)} ${show(c)}`)) + + Right(res) => + Test.assertEquals(res, expected) + }, +)(toParse) + +parseTest :: (Show a, Eq a) => String + -> Parse.Parser a + -> String + -> a + -> Wish Test.TestResult Test.TestResult +export parseTest = (testName, parser, toParse, expected) => Test.test( + testName, + () => testParser(parser, toParse, expected), +) + +parseFile :: (Show a, Eq a) => String + -> String + -> Parse.Parser a + -> a + -> Wish Test.TestResult Test.TestResult +export parseFile = (filePath, testName, parser, expected) => Test.test( + testName, + () => pipe( + IO.pTrace("reading file..."), + File.read, + IO.pTrace("read file!"), + Wish.mapRej(always(TestError("File reading error"))), + chain((FIXTURE) => testParser(parser, FIXTURE, expected)), + )(filePath), +) diff --git a/src/Yaml.mad b/src/Yaml.mad new file mode 100644 index 0000000..4afcb52 --- /dev/null +++ b/src/Yaml.mad @@ -0,0 +1,212 @@ +import type { Either } from "Either" +import type { Maybe } from "Maybe" +import type { Parser } from "Parse" + +import { apL } from "Applicative" +import Dict from "Dictionary" +import { fromRight } from "Either" +import { mapLeft } from "Either" +import {} from "Float" +import { always, equals, identity } from "Function" +import { mapL } from "Functor" +import IO from "IO" +import { dropWhile, mapMaybe } from "List" +import { Just, Nothing, fromMaybe } from "Maybe" +import P from "Parse" +import String from "String" + +import { between } from "@/Combinators" +import { linkCharacter } from "@/Link" +import { SPACE, blank, end, maybeMinus, singleReturnTerminal } from "@/Shared" + + + +// https://help.obsidian.md/Editing+and+formatting/Properties +// MadMarkdownParser aims to support the YAML that is supported by Obsidian, +// _not_ the entire YAML spec +export type YamlValue + = YamlString(String) + | YamlFloat(Float) + | YamlInteger(Integer) + | YamlBoolean(Boolean) + | YamlLink(String, String) + | YamlInternalLink(String, String) + | YamlDate(String) + | YamlList(List YamlValue) + +// key / value +export type YamlPair = YamlPair(String, YamlValue) + +export alias YamlData = List YamlPair + +link :: P.Parser YamlValue +export link = pipe( + map(YamlLink), + ap( + $, + between( + P.char('('), + pipe( + P.many, + map(String.fromList), + )(linkCharacter), + P.char(')'), + ), + ), +)( + between( + P.char('['), + pipe( + P.many, + map(String.fromList), + )(P.notOneOf([']', '\n'])), + P.char(']'), + ), +) + +shortInternalLink :: Parser YamlValue +export shortInternalLink = do { + _ <- P.string(`"[[`) + ref <- pipe( + P.manyTill(P.letter), + map(String.fromList), + )(P.string(`]]"`)) + _ <- P.string(`]]"`) + return pipe( + YamlInternalLink(ref), + of, + )(ref) +} + +internalLinkWithDisplay :: Parser YamlValue +export internalLinkWithDisplay = do { + _ <- P.string(`"[[`) + url <- pipe( + P.many, + map(String.fromList), + )(linkCharacter) + _ <- P.char('|') + ref <- pipe( + P.manyTill(P.letter), + map(String.fromList), + )(P.string(`]]"`)) + _ <- P.string(`]]"`) + return pipe( + YamlInternalLink(ref), + of, + )(url) +} + +internalLink :: P.Parser YamlValue +export internalLink = P.choice([internalLinkWithDisplay, shortInternalLink]) + +boolean :: P.Parser YamlValue +export boolean = pipe( + alt(map(always(false), P.symbol("false"))), + map(YamlBoolean), +)(map(always(true), P.symbol("true"))) + +integer :: P.Parser YamlValue +export integer = do { + minus <- maybeMinus + digits <- P.some(P.digit) + return pipe( + String.fromList, + scan, + fromMaybe(0), + YamlInteger, + of, + )([...minus, ...digits]) +} +float :: P.Parser YamlValue +export float = do { + minus <- maybeMinus + whole <- P.some(P.digit) + dot <- P.char('.') + fraction <- P.some(P.digit) + + return pipe( + String.fromList, + scan, + fromMaybe(0), + YamlFloat, + of, + )([...minus, ...whole, dot, ...fraction]) +} + +export textTerminals = P.choice([end, P.string("\n")]) + +export text = map( + pipe( + String.fromList, + String.trim, + YamlString, + ), + P.someTill(P.anyChar, textTerminals), +) + +export yamlSingleContent = P.choice([boolean, link, internalLink, float, integer, text]) + + +export ulistItemStart = blank(apL(P.many(SPACE), apL(P.char('-'), P.some(SPACE)))) + +export listItem = chain(always(apL(yamlSingleContent, singleReturnTerminal)), ulistItemStart) + +yamlList :: P.Parser YamlValue +export yamlList = pipe( + P.some, + map(YamlList), +)(listItem) + +newlineYamlList :: P.Parser YamlValue +export newlineYamlList = do { + _ <- P.char('\n') + list <- yamlList + return of(list) +} + +alphanumeric :: Parser String +alphanumeric = do { + firstChar <- P.letter + rest <- P.many(P.choice([P.letter, P.digit])) + return pipe( + String.fromList, + of, + )([firstChar, ...rest]) +} + + +yamlPair :: P.Parser YamlPair +export yamlPair = do { + key <- P.token(alphanumeric) + _ <- P.symbol(":") + value <- P.token(P.choice([newlineYamlList, yamlSingleContent])) + return pipe( + YamlPair(key, $), + of, + )(value) +} + +export yamlContent = P.many(yamlPair) + +yaml :: P.Parser (Dictionary String YamlValue) +export yaml = do { + pairs <- P.sepBy(yamlPair, P.char('\n')) + return pipe( + map(where { YamlPair(k, v) => #[k, v] }), + Dict.fromList, + of, + )(pairs) +} + +markYaml :: P.Parser (Dictionary String YamlValue) +export markYaml = do { + _ <- P.symbol("---") + pairs <- P.many(yamlPair) + _ <- P.symbol("---") + return pipe( + map(where { YamlPair(k, v) => #[k, v] }), + Dict.fromList, + of, + )(pairs) +} diff --git a/src/Yaml.spec.mad b/src/Yaml.spec.mad new file mode 100644 index 0000000..9445352 --- /dev/null +++ b/src/Yaml.spec.mad @@ -0,0 +1,145 @@ +import Dict from "Dictionary" +import { Left, Right } from "Either" +import File from "File" +import { always } from "Function" +import P from "Parse" +import Parse from "Parse" +import Test from "Test" +import Wish from "Wish" + + + +assertEquals = Test.assertEquals +test = Test.test +TestError = Test.Error + +import { parseFile, parseTest, testParser } from "@/Test" +import { + YamlBoolean, + YamlFloat, + YamlInteger, + YamlInternalLink, + YamlLink, + YamlList, + YamlPair, + YamlString, + boolean, + float, + integer, + internalLink, + internalLinkWithDisplay, + link, + newlineYamlList, + text, + yaml, + yamlContent, + yamlList, + yamlPair, + yamlSingleContent, +} from "@/Yaml" + + + +parseTest("yamlPair - newline", yamlPair, "cool: nice\n", YamlPair("cool", YamlString("nice"))) +parseTest("yamlPair - eof", yamlPair, "cool: nice", YamlPair("cool", YamlString("nice"))) +parseTest("yamlPair - boolean", yamlPair, "cool: true", YamlPair("cool", YamlBoolean(true))) +test( + "yamlSingleContent", + () => do { + run = testParser(yamlSingleContent) + _ <- run("whatever whatever ", YamlString("whatever whatever")) + _ <- run("true", YamlBoolean(true)) + _ <- run("false", YamlBoolean(false)) + _ <- run("39309402334827", YamlInteger(39309402334827)) + _ <- run("209392002.3992", YamlFloat(209392002.3992)) + _ <- run(`"[[whatever]]"`, YamlInternalLink("whatever", "whatever")) + _ <- run(`"[[whatever|whenever]]"`, YamlInternalLink("whenever", "whatever")) + return run("[website](https://website.biz)", YamlLink("website", "https://website.biz")) + }, +) + +parseTest( + "yamlList", + yamlList, + ` - a + - b + - c`, + YamlList([YamlString("a"), YamlString("b"), YamlString("c")]), +) + +parseTest( + "newlineYamlList", + newlineYamlList, + ` + - a + - b + - c`, + YamlList([YamlString("a"), YamlString("b"), YamlString("c")]), +) + +test( + "yaml", + () => do { + FIRST_CASE = `a: yo +b: true +c: false +d: 123850.23 +e: 240 +f: [link](site) +g: "[[hoho|yoyo]]"` + parseYaml = testParser(yaml) + _ <- parseYaml( + FIRST_CASE, + {{ + "a": YamlString("yo"), + "b": YamlBoolean(true), + "c": YamlBoolean(false), + "d": YamlFloat(123850.23), + "e": YamlInteger(240), + "f": YamlLink("link", "site"), + "g": YamlInternalLink("yoyo", "hoho"), + }}, + ) + return parseYaml( + `h: + - i`, + {{ "h": YamlList([YamlString("i")]) }}, + ) + }, +) + +// parseFile("./YAML_FIXTURE.yaml", "yaml fixture", yaml, {{}}) + +test( + "text", + () => do { + run = testParser(text) + _ <- run("whatever whatever ", YamlString("whatever whatever")) + _ <- run("costs 200.399", YamlString("costs 200.399")) + return run("12932929", YamlString("12932929")) + }, +) +parseTest("float", float, "209392002.3992", YamlFloat(209392002.3992)) +parseTest("integer", integer, "13902291", YamlInteger(13902291)) +parseTest( + "internalLink - short", + internalLink, + `"[[heynow]]"`, + YamlInternalLink("heynow", "heynow"), +) +parseTest( + "internalLink - long", + internalLink, + `"[[link|display]]"`, + YamlInternalLink("display", "link"), +) +parseTest("boolean - true", boolean, "true", YamlBoolean(true)) +parseTest("boolean - false", boolean, "false", YamlBoolean(false)) +parseTest( + "link", + link, + "[website](https://madlib.space)", + YamlLink("website", "https://madlib.space"), +) + +// parseFile("./YAML_FIXTURE.yaml", "parse yaml file", yamlContent, [])