From c3f2f98dc815b52a1d54cf04359d69aef61ccc15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?linus=20bj=C3=B6rnstam?= Date: Thu, 2 Apr 2026 10:06:59 +0200 Subject: [PATCH] TagRenderers can output Blocks, we now slurp sections The big one is probably that tagrenderers can output blocks such as tables. We also slurp sections, so that subsections become a part of the above sections children. The FSI evaluator adds about 1000% of runtime for testing, so I added a NullEvaluator. I also added default constructors for many of the base elements. The parsers are not yet done, but you can do very rudimentary tables. The AST has gotten a large update, and it is pretty much complete. --- Fibble.slnx | 6 + src/Bif/Bif.fsproj | 3 + src/Bif/Program.fs | 97 ++--- src/Bif/_page-template | 53 +++ src/Bif/document.fib | 42 +- src/FibLib/AstUtils.fs | 115 ++++++ src/FibLib/FibLib.fsproj | 1 + src/FibLib/HtmlPrinter.fs | 201 +++++++--- src/FibLib/Library.fs | 649 +++++++++++++++++++++---------- src/FibLib/Pandoc.fs | 29 +- src/FibLib/constructorHelpers.fs | 83 ++-- 11 files changed, 875 insertions(+), 404 deletions(-) create mode 100644 Fibble.slnx create mode 100644 src/Bif/_page-template create mode 100644 src/FibLib/AstUtils.fs diff --git a/Fibble.slnx b/Fibble.slnx new file mode 100644 index 0000000..cbf8a5b --- /dev/null +++ b/Fibble.slnx @@ -0,0 +1,6 @@ + + + + + + diff --git a/src/Bif/Bif.fsproj b/src/Bif/Bif.fsproj index 8d26c7e..fb0e0a5 100644 --- a/src/Bif/Bif.fsproj +++ b/src/Bif/Bif.fsproj @@ -7,6 +7,9 @@ + + + diff --git a/src/Bif/Program.fs b/src/Bif/Program.fs index 4f6aa83..2191e84 100644 --- a/src/Bif/Program.fs +++ b/src/Bif/Program.fs @@ -1,84 +1,59 @@ -open System.Net -open System.IO -open System.Runtime.CompilerServices -open FSharp.Compiler.Text +open System.IO open Fibble.FibLib -open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc. -open Fibble.FibLib.Pandoc +open Fibble.FibLib.Ast open Fibble.FibLib.HtmlPrinter -open Fibble.FibLib.Utils open Fibble.FibLib.ConstructionHelpers -// ========================================== -// 1. Prelude (Dina egna taggar) -// ========================================== +let myPrelude: Map = + Map + [ "quotient", + fun _ args _ _ -> + match args with + | [ one; two ] -> Inline(Text(sprintf "%d" (int one / int two))) + | _ -> Inline(Text "[Fel: quotient kräver två argument]") + "bold", fun _ _ _ children -> Inline(Strong(children)) + "kursiv", fun _ _ _ children -> Inline(Emph(children)) + "image", image + "value", value + "link", link + "list", + fun _ _ _ c -> + System.Console.WriteLine(c) + Inline(RawHtml "hej") + "br", linebreak + "table", table -let myPrelude : Map = - Map [ - "quotient", fun _ args _ _ -> - match args with - | [one; two] -> - Text (sprintf "%d" (int one / int two)) - | _ -> - Text "[Fel: quotient kräver två argument]" - "bold", fun _ _ _ children -> - Strong(children) - "kursiv", fun _ _ _ children -> Emph(children) - "image", image - "value", value - "link", link - "list", fun _ _ _ c -> System.Console.WriteLine(c) - RawHtml "hej" - - // @br har varken argument eller barn, så vi returnerar bara rå HTML direkt - "br", linebreak - "table", fun _ _ _ children -> Text "hej" - "md", fun _ _ _ children -> RawHtml (mdToHtml (stringifyNodes children)) - ] + "md", fun _ _ _ _ -> Inline(Text "hej") ] -// ========================================== -// 2. Mall och Evaluator -// ========================================== -// module File = let readFile path = match Path.Exists(path) with - | true -> File.ReadAllText(path) - | _ -> failwith $"{Path.GetFullPath path} does not exist" + | true -> File.ReadAllText(path) + | _ -> failwith $"{Path.GetFullPath path} does not exist" let pageTemplate = File.readFile "_page-template" let sourceCode = File.readFile "document.fib" -// ========================================== -// 3. Huvudpipeline -// ========================================== + + let processDocument (source: string) = - let evaluator = Evaluators.FsiEvaluator() - - // Steg 1: Parsa koden - let metadata, rawBlocks = Parser.parse source - + let evaluator = Evaluators.NullEvaluator() - // Steg 2: Transformera och exekvera trädet - let evaluatedBlocks = - rawBlocks |> List.map (function - | Paragraph children -> - Paragraph (children - |> List.map (Execution.transform metadata myPrelude evaluator)) - | Section(l, a, children) -> - Section(l, a, children - |> List.map (Execution.transform metadata myPrelude evaluator)) - | _ -> failwith "haha" - - ) + // Parsa koden + let metadata, raewBlocks = Parser.parse source + let rawBlocks = AstUtils.slurpSections raewBlocks - // Steg 3: Be printern skriva ut trädet till HTML - let bodyHtml = HtmlPrinter.render evaluatedBlocks + + let evaluatedBlocks = + CommandEvaluator.evaluateDocument metadata myPrelude evaluator rawBlocks + + // Be printern skriva ut trädet till HTML + let bodyHtml = HtmlWriter.renderDocument evaluatedBlocks // Steg 4: Fyll i din HTML-mall let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml) - + finalHtml // Kör programmet diff --git a/src/Bif/_page-template b/src/Bif/_page-template new file mode 100644 index 0000000..121840b --- /dev/null +++ b/src/Bif/_page-template @@ -0,0 +1,53 @@ + + + + + + + + {{title}} + + + + + +× + +
+ +

{{title}}

+
+ by {{author}} + {{date}} +
+ +
+{{body}} + + +
+
+ All images (except icons) are, unless otherwise specified, in the public domain. For the rest of the content, the following apply:
+ +
+
+ + Creative Commons License + +
+ +
+ This work by Linus Björstam is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License. +
+
+
+ +
+ + diff --git a/src/Bif/document.fib b/src/Bif/document.fib index 9bd2254..75d9edf 100644 --- a/src/Bif/document.fib +++ b/src/Bif/document.fib @@ -6,44 +6,10 @@ title: FSI Test @section{Definitioner} Vi definierar en funktion och en variabel. -@""" -let globalCounter = ref 0 -let increment () = - globalCounter.Value <- globalCounter.Value + 1 - sprintf "Räknaren är nu %d" globalCounter.Value -""" -@(1) - -@link[www.google.com]{hejsan hoppsan fallerallera} - -Detta är en paragraf som har lite text i sig och lite @md{inbäddad *markdown* som kanske} funkar. Det är bra så. - -@md{ -babeuoastnuhaoesn - -hej hopp ---- ---- -abc defg -bde dddd -ueo eoau -ueo aoeu +@table{ +rubrik 1 | rubrik 2 +1 | 3 +2 | 4 } -elleR? - -@list{ -Första saken -Andra saken med @bold{text} -Tredje saken -} - -@section{Användning} -Första anropet: @(increment()) -Andra anropet: @(increment()) - -@bold{detta är ibdenrerat. - detta också. - hej} - -Test av utskrift: @value[date] diff --git a/src/FibLib/AstUtils.fs b/src/FibLib/AstUtils.fs new file mode 100644 index 0000000..b4a0423 --- /dev/null +++ b/src/FibLib/AstUtils.fs @@ -0,0 +1,115 @@ +namespace Fibble.FibLib + +module AstUtils = + open Ast + // Hjälpfunktion som samlar block rekursivt + let rec private gatherBlocks (currentLevel: int) (nodes: BlockNode list) : BlockNode list * BlockNode list = + match nodes with + | [] -> [], [] + + // Byt namn till 'existingBlocks' för tydlighet + | Section(attr, lvl, title, existingBlocks) :: tail when lvl > currentLevel -> + + // 1. Samla in de Nya blocken som tillhör undersektionen från tail + let gatheredBlocks, restAfterSub = gatherBlocks lvl tail + + // SÄKERHETSFIX: Slå ihop de gamla och de nya blocken! + let combinedBlocks = existingBlocks @ gatheredBlocks + let newSection = Section(attr, lvl, title, combinedBlocks) + + // 2. Fortsätt samla in syskon till denna undersektion + let siblingBlocks, remaining = gatherBlocks currentLevel restAfterSub + newSection :: siblingBlocks, remaining + + // Vi hittar en sektion på samma eller "högre" nivå + | Section(_, lvl, _, _) :: _ when lvl <= currentLevel -> [], nodes + + // Vanliga block (Paragraph, Table, etc.) + | block :: tail -> + let siblingBlocks, remaining = gatherBlocks currentLevel tail + block :: siblingBlocks, remaining + + + let slurpSections ast = + let nestedAst, _ = gatherBlocks 0 ast + nestedAst + + let splitByNewlines (nodes: InlineNode list) = + // Folder-funktionen håller koll på: (Pågående rad, Lista med färdiga rader) + let folder (currentLine, completedLines) node = + match node with + | Text t -> + // Splitta texten. Vi tar bort \r för att stödja både Windows och Mac/Linux. + let lines = t.Replace("\r", "").Split('\n') |> Array.toList + + match lines with + | [] -> (currentLine, completedLines) // Händer aldrig med Split + | [ single ] -> + // Ingen radbrytning hittades, fortsätt bygga på nuvarande rad + (Text single :: currentLine, completedLines) + | first :: rest -> + // Vi hittade minst en radbrytning! + // 1. Avsluta den pågående raden med första delen av texten + let finishedFirstLine = List.rev (Text first :: currentLine) + + // 2. Den sista biten text blir början på nästa rad + let lastPart = rest |> List.last + + // 3. Allt i mitten är egna fristående rader + let middleLines = + rest |> List.take (rest.Length - 1) |> List.map (fun s -> [ Text s ]) + + // Skicka tillbaka (Ny pågående rad, Uppdaterad lista med färdiga rader) + ([ Text lastPart ], completedLines @ [ finishedFirstLine ] @ middleLines) + + | otherNode -> + // Är det t.ex. ett Command lägger vi bara till det på pågående rad + (otherNode :: currentLine, completedLines) + + // Kör foldern över alla noder + let finalLine, allCompletedLines = List.fold folder ([], []) nodes + let allLinesRaw = allCompletedLines @ [ List.rev finalLine ] + + // --- STÄDNING --- + // Ta bort tomma text-noder (skräp från splitten) och kasta helt tomma rader + allLinesRaw + |> List.map ( + List.choose (function + | Text t when System.String.IsNullOrWhiteSpace(t) -> None + | validNode -> Some validNode) + ) + |> List.filter (not << List.isEmpty) + + + + let splitByPipe (nodes: InlineNode list) = + let folder (currentCell, completedCells) node = + match node with + | Text t -> + // Klyv på rör-tecknet istället + let parts = t.Split('|') |> Array.toList + + match parts with + | [] -> (currentCell, completedCells) + | [ single ] -> (Text single :: currentCell, completedCells) + | first :: rest -> + let finishedFirstCell = List.rev (Text first :: currentCell) + let lastPart = rest |> List.last + + let middleCells = + rest |> List.take (rest.Length - 1) |> List.map (fun s -> [ Text s ]) + + ([ Text lastPart ], completedCells @ [ finishedFirstCell ] @ middleCells) + + | otherNode -> (otherNode :: currentCell, completedCells) + + let finalCell, allCompletedCells = List.fold folder ([], []) nodes + let allCellsRaw = allCompletedCells @ [ List.rev finalCell ] + + // Städa bort helt tomma text-noder som uppstår vid klyvningen + allCellsRaw + |> List.map ( + List.choose (function + | Text t when System.String.IsNullOrWhiteSpace(t) -> None + | validNode -> Some validNode) + ) diff --git a/src/FibLib/FibLib.fsproj b/src/FibLib/FibLib.fsproj index 2765919..91b09b4 100644 --- a/src/FibLib/FibLib.fsproj +++ b/src/FibLib/FibLib.fsproj @@ -8,6 +8,7 @@ + diff --git a/src/FibLib/HtmlPrinter.fs b/src/FibLib/HtmlPrinter.fs index 17c607d..c66ca56 100644 --- a/src/FibLib/HtmlPrinter.fs +++ b/src/FibLib/HtmlPrinter.fs @@ -4,60 +4,151 @@ module Fibble.FibLib.HtmlPrinter open System.Net -module HtmlPrinter = +module HtmlWriter = open Ast - open System.Net - let renderAttributes (args: (string * string) list) = - args - |> List.map (fun k -> sprintf "%s=\"%s\"" (fst k) (snd k)) - |> String.concat " " - let rec renderInline = - let renderAll l = - l - |> List.map renderInline - |> String.concat "" - function - | Text t -> WebUtility.HtmlEncode t - | Strong(t) -> sprintf "%s" (renderAll t) - | RawHtml h -> - h - | _ -> "" - - let renderFigure a c l = - failwith "haha" - - let renderListItem item = - sprintf "
  • %s
    • " item - - let renderList kind attributes nodesList = - let content = nodesList - |> List.map renderListItem - |> String.concat "\n" - $"<{kind} {(renderAttributes attributes)}>{content}" - - let rec render blocks = - let doubleRender blocksblock = - List.map render blocksblock - - let renderNode = function - | Paragraph [RawHtml html] -> - html - | Paragraph nodes when nodes |> List.forall (function - | RawHtml _ -> true - | Text t when System.String.IsNullOrWhiteSpace(t) -> true - | _ -> false) -> - nodes - |> List.choose (function RawHtml h -> Some h | _ -> None) - |> String.concat "\n" - | Paragraph c -> sprintf "

    %s

    " (c |> List.map renderInline |> String.concat "") - | Section(l, _, c) -> sprintf "%s" l (c |> List.map renderInline |> String.concat "") l - | CodeBlock(attributes, text) -> sprintf "%s" text - | Figure(attributes, caption, blocks) -> renderFigure attributes caption blocks - | ListBlock(l) -> match l with - | BulletList(attr, blocknodes) -> renderList "ul" attr.kvp (doubleRender blocknodes) - | Orderedlist(attr, start, blocknodes) -> renderList "ol" attr.kvp (doubleRender blocknodes) - | Plain nodes -> List.map renderInline nodes |> String.concat " " - blocks - |> List.map renderNode - |> String.concat "\n" + // --- HJÄLPARFUNKTIONER --- + + let escapeHtml (text: string) = + if System.String.IsNullOrEmpty(text) then + "" + else + WebUtility.HtmlEncode(text) + + // Plockar ut ren text för attribut som alt-texter där vi inte får ha HTML-taggar + let rec extractText (nodes: InlineNode list) = + nodes + |> List.map (function + | Text t -> t + | RawHtml h -> h + | Emph c + | Underline c + | Strong c + | Strikeout c + | Superscript c + | Subscript c -> extractText c + | Link(_, (_, c)) -> extractText c + | Code(_, t) -> t + | _ -> "") + |> String.concat "" + + // Bygger attributsträngen: id="X" class="Y Z" key="value" + let renderAttr (attr: Attr) = + let idStr = + if System.String.IsNullOrWhiteSpace(attr.id) then + "" + else + sprintf " id=\"%s\"" attr.id + + let classStr = + match attr.classes with + | [] -> "" + | classes -> sprintf " class=\"%s\"" (String.concat " " classes) + + let kvpStr = + match attr.kvp with + | [] -> "" + | kvps -> + let pairs = kvps |> List.map (fun (k, v) -> sprintf "%s=\"%s\"" k v) + " " + (String.concat " " pairs) + + idStr + classStr + kvpStr + + + + // --- HUVUDRENDERARE --- + + let rec renderDocument (blocks: BlockNode list) = + blocks |> List.map renderBlock |> String.concat "" + + // Renderar Block-noder + and renderBlock = + function + | Paragraph children -> sprintf "

    %s

    \n" (renderInlines children) + + | Plain inlines -> sprintf "%s\n" (renderInlines inlines) + + | CodeBlock(attr, text) -> sprintf "
    %s
    \n" (renderAttr attr) (escapeHtml text) + + | Figure(attr, caption, blocks) -> + let bodyHtml = blocks |> List.map renderBlock |> String.concat "" + let captionHtml = renderInlines caption + sprintf "\n%s
    %s
    \n\n" (renderAttr attr) bodyHtml captionHtml + + | Section(attr, lvl, title, body) -> + // Begränsa h-nivåer till h1-h6 för giltig HTML + let hLvl = max 1 (min 6 lvl) + let titleHtml = renderInlines title + let bodyHtml = body |> List.map renderBlock |> String.concat "" + sprintf "\n%s\n%s\n" (renderAttr attr) hLvl titleHtml hLvl bodyHtml + + | ListBlock kind -> + match kind with + | Orderedlist(attr, start, blocksList) -> + let startAttr = if start <> 1 then sprintf " start=\"%d\"" start else "" + + let itemsHtml = + blocksList + |> List.map (fun b -> sprintf "
  • %s
    • \n" (b |> List.map renderBlock |> String.concat "")) + |> String.concat "" + + sprintf "\n%s\n" (renderAttr attr) startAttr itemsHtml + + | BulletList(attr, blocksList) -> + let itemsHtml = + blocksList + |> List.map (fun b -> sprintf "
  • %s
    • \n" (b |> List.map renderBlock |> String.concat "")) + |> String.concat "" + + sprintf "\n%s\n" (renderAttr attr) itemsHtml + | Table(attr, rows) -> + let renderedRows = List.map renderRow rows |> String.concat " " + sprintf "%s" (renderAttr attr) renderedRows + + // Renderar en lista av Inline-noder + and renderInlines inlines = + inlines |> List.map renderInline |> String.concat "" + + // Renderar enskilda Inline-noder + and renderInline = + function + | Text t -> escapeHtml t + | RawHtml h -> h + + // Formatering + | Emph c -> sprintf "%s" (renderInlines c) + | Strong c -> sprintf "%s" (renderInlines c) + | Underline c -> sprintf "%s" (renderInlines c) + | Strikeout c -> sprintf "%s" (renderInlines c) + | Superscript c -> sprintf "%s" (renderInlines c) + | Subscript c -> sprintf "%s" (renderInlines c) + + // Länkar och bilder + | Link(attr, (url, content)) -> sprintf "%s" url (renderAttr attr) (renderInlines content) + + | Image(attr, altText, url) -> + // Bild-alt måste vara ren text (får ej innehålla , etc) + let cleanAlt = extractText altText |> escapeHtml + sprintf "\"%s\"%s" url cleanAlt (renderAttr attr) + + | Code(attr, text) -> sprintf "%s" (renderAttr attr) (escapeHtml text) + + | SoftBreak -> "\n" + | LineBreak -> "
    " + + | Expr(_, resultOpt) -> resultOpt |> Option.defaultValue "" + + | Note _ -> + // Fotnoter renderas oftast som en ankarlänk här, och själva innehållet längst ner på sidan. + // (Detta kan vi implementera senare när du bygger det globala state-systemet) + "[ref]" + + | Command(tag, _, _, _) -> + // Denna nod borde inte existera längre om Evaluatorn har gjort sitt jobb + failwithf "Kritiskt fel: Oexpanderat makro '@%s' nådde HTML-renderaren!" tag + + and renderRow (Row cells) = + let renderedCell (Cell children) = + sprintf "%s" (renderInlines children) + + List.map renderedCell cells |> String.concat "" |> sprintf "%s\n" diff --git a/src/FibLib/Library.fs b/src/FibLib/Library.fs index 87fa452..e6f12ff 100644 --- a/src/FibLib/Library.fs +++ b/src/FibLib/Library.fs @@ -1,6 +1,7 @@ namespace Fibble.FibLib -open System.Net + +open System open FParsec open YamlDotNet.Serialization open System.Collections.Generic @@ -10,10 +11,13 @@ open System.Collections.Generic // 1. AST & Utils // ========================================== module Ast = - - type Attr = { id: string; classes: string list; kvp: (string * string) list } - - + + type Attr = + { id: string + classes: string list + kvp: (string * string) list } + + type InlineNode = | Text of string | RawHtml of string @@ -31,114 +35,149 @@ module Ast = | LineBreak | Expr of code: string * result: string option | Command of tag: string * args: string list * kwargs: Map * children: InlineNode list + and BlockNode = + | BlockCommand of tag: string * args: string list * kwargs: Map * children: InlineNode list | CodeBlock of attributes: Attr * text: string - | Figure of attributes: Attr * caption: InlineNode list * blocks: BlockNode list + | Figure of attributes: Attr * caption: InlineNode list * blocks: BlockNode list | ListBlock of ListKind | Plain of InlineNode list | Paragraph of children: InlineNode list - | Section of level: int * args: (string * string) list * children: InlineNode list - and ListKind = + | Section of attributes: Attr * level: int * title: InlineNode list * body: BlockNode list + | Table of attrs: Attr * rows: TableRow list + + and TableRow = Row of cells: TableCell list + and TableCell = Cell of children: InlineNode list + + and ListKind = | Orderedlist of attributes: Attr * start: int * blocksList: (BlockNode list) list | BulletList of attributes: Attr * blocksList: (BlockNode list) list + and Url = string and Target = Url * InlineNode list type Document = BlockNode list - type TagRenderer = Map - -> string list - -> Map - -> InlineNode list -> InlineNode + type TocEntry = + | TocGroup of title: string * id: string * children: TocEntry list + | TocEntity of title: string * id: string + + type NextDocument = + { document: BlockNode list + Toc: TocEntry list + Footnotes: BlockNode list list + Metadata: Map } + + type NodeResult = + | Inline of InlineNode + | Block of BlockNode + + type TagRenderer = Map -> string list -> Map -> InlineNode list -> NodeResult + - let rec stringifyNodes (nodes: InlineNode list) = - nodes - |> List.map (function - | Text t -> t - | RawHtml h -> h - | Expr(_, Some res) -> res - | Expr(code, None) -> sprintf "@(%s)" code // Fallback om den inte evaluerats - | _ -> failwith "haha" - ) - |> String.concat "" module Utils = open Ast + let dedentNodes (nodes: InlineNode list) = - let fullText = - nodes |> List.choose (function Text t -> Some t | _ -> None) |> String.concat "" - + let fullText = + nodes + |> List.choose (function + | Text t -> Some t + | _ -> None) + |> String.concat "" + let lines = fullText.Replace("\r\n", "\n").Split('\n') - + // 1. Räkna BARA ut minIndent från rader som kommer efter en radbrytning (skippa rad 0) - let minIndent = - if lines.Length <= 1 then 0 + let minIndent = + if lines.Length <= 1 then + 0 else - lines |> Array.skip 1 + lines + |> Array.skip 1 |> Array.filter (fun l -> not (System.String.IsNullOrWhiteSpace(l))) |> Array.map (fun l -> l.Length - l.TrimStart().Length) - |> function [||] -> 0 | arr -> Array.min arr + |> function + | [||] -> 0 + | arr -> Array.min arr let mutable isFirstText = true let indentStr = "\n" + String.replicate minIndent " " // 2. Applicera formateringen - let dedented = - nodes |> List.map (function - | Text t -> + let dedented = + nodes + |> List.map (function + | Text t -> let t1 = t.Replace("\r\n", "\n") - + // Ta bort inledande mellanslag på den allra första texten direkt efter '{' - let t2 = - if isFirstText then + let t2 = + if isFirstText then isFirstText <- false t1.TrimStart(' ', '\t') - else t1 - + else + t1 + // Ta bort minIndent antal mellanslag efter varje radbrytning i noden let t3 = if minIndent > 0 then t2.Replace(indentStr, "\n") else t2 Text t3 - | otherNode -> otherNode - ) + | otherNode -> otherNode) // 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna - let rec trimStart = function - | Text t :: rest -> + let rec trimStart = + function + | Text t :: rest -> let trimmed = t.TrimStart('\n', '\r', ' ', '\t') - if trimmed = "" then trimStart rest else Text trimmed :: rest + + if trimmed = "" then + trimStart rest + else + Text trimmed :: rest | other -> other - - let rec trimEnd = function - | Text t :: rest -> + + let rec trimEnd = + function + | Text t :: rest -> let trimmed = t.TrimEnd('\n', '\r', ' ', '\t') if trimmed = "" then trimEnd rest else Text trimmed :: rest | other -> other - + dedented |> trimStart |> List.rev |> trimEnd |> List.rev - let positional f: TagRenderer = + let positional f : TagRenderer = fun _ (args: string list) _ children -> f args children - + let onlyArgs f = fun _ args kwargs children -> f args kwargs - let getArgIdx (args: (string*string) list) index defaultVal = + let getArgIdx (args: (string * string) list) index defaultVal = let unnamed = args |> List.filter (fun (k, _) -> k = "") - if index < unnamed.Length then (snd unnamed.[index]).Trim('"') - else defaultVal + + if index < unnamed.Length then + (snd unnamed.[index]).Trim('"') + else + defaultVal // This gets the arg defined by "key" unless it is not set, it then tries to get it by index. If that fails, it gets the defaultVal let getArg (args: (string * string) list) (key: string) (index: int) (defaultVal: string) = match args |> List.tryFind (fun (k, _) -> k = key) with - | Some (_, v) -> v.Trim('"') + | Some(_, v) -> v.Trim('"') | None -> getArgIdx args index defaultVal - + let withArg1 def (f: string -> InlineNode list -> InlineNode) = fun _ args children -> f (getArgIdx args 0 def) children - let withArg2 (k1: string) (d1: string) (k2: string) (d2: string) (f: string -> string -> InlineNode list -> InlineNode) = + let withArg2 + (k1: string) + (d1: string) + (k2: string) + (d2: string) + (f: string -> string -> InlineNode list -> InlineNode) + = fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children @@ -150,183 +189,247 @@ module Utils = module Parser = open Ast + let pseudoRandom = new System.Random() - let pInline, pInlineRef = createParserForwardedToRef() + let pInline, pInlineRef = createParserForwardedToRef () let getSectionLevel (name: string) = - if name = "section" then 1 - elif name = "subsection" then 2 - elif name.StartsWith("sub") && name.EndsWith("section") then (name.Length - 7) / 3 + 1 - else 1 + if name = "section" then + 1 + elif name = "subsection" then + 2 + elif name.StartsWith("sub") && name.EndsWith("section") then + (name.Length - 7) / 3 + 1 + else + 1 + + let rec alistGet<'T when 'T: comparison> (lst: ('T * 'B) list) (k: 'T) = + match lst with + | [] -> None + | ktp :: _ when (fst ktp) = k -> Some(snd ktp) + | _ :: rst -> alistGet rst k + + let separateArgs rawArgs : (string list * (string * string) list) = + let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None) + let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") + posArgs, kwargs let isSection (name: string) = name.EndsWith("section") let pNewline = newline - + let pNamedArg = // Leta efter "nyckel=värde" - attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_") - .>> spaces .>> pchar '=' .>> spaces) + attempt ( + many1Chars (asciiLetter <|> digit <|> anyOf "-_") + .>> spaces + .>> pchar '=' + .>> spaces + ) .>>. manyChars (noneOf ",]") - |>> fun (k, v) -> (k, v.Trim()) + |>> fun (k, v) -> k, v.Trim() let pPositionalArg = // Bara "värde" - manyChars (noneOf ",]") |>> fun v -> ("", v.Trim()) + manyChars (noneOf ",]") |>> fun v -> "", v.Trim() let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces - let pArgs = + let pArgs = between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ',')) >>= fun args -> // Validera att positionella argument alltid kommer först - let rec validate canBePositional = function + let rec validate canBePositional = + function | [] -> preturn args // Allt är okej, returnera listan - | ("", _) :: tail -> - if not canBePositional then + | ("", _) :: tail -> + if not canBePositional then fail "Syntaxfel: Positionella argument får inte komma efter namngivna argument." - else validate true tail - | _ :: tail -> - validate false tail - + else + validate true tail + | _ :: tail -> validate false tail + validate true args - // --- 1. Måsvinge-parser (för @kommandon) --- - // Lägg till en referens för pBody högst upp bland dina referenser - // (Bör ligga precis under let pInline, pInlineRef = ...) - let pBody, pBodyRef = createParserForwardedToRef() + + let pBody, pBodyRef = createParserForwardedToRef () // --- 2. Parentes-parser (för @(...) med sträng-stöd) --- - let pParenBody, pParenBodyRef = createParserForwardedToRef() + let pParenBody, pParenBodyRef = createParserForwardedToRef () let pFSharpString = let normal = many1Chars (noneOf "\"\\") let escaped = pstring "\\" >>. anyChar |>> sprintf "\\%c" + pstring "\"" .>>. manyStrings (normal <|> escaped) .>>. pstring "\"" |>> fun ((start, inner), end_) -> start + inner + end_ - pParenBodyRef.Value <- - manyStrings (choice [ - pFSharpString - many1Chars (noneOf "()\"") - pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" - ]) + pParenBodyRef.Value <- + manyStrings ( + choice + [ pFSharpString + many1Chars (noneOf "()\"") + pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" ] + ) - let pExpr = - attempt (pstring "@(") >>. pParenBody .>> pstring ")" - |>> fun c -> Expr(c, None) + let pExpr = + attempt (pstring "@(") >>. pParenBody .>> pstring ")" |>> fun c -> Expr(c, None) // --- Övriga inline-parsers --- - let pMultilineCode = - pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"") - |>> fun c -> Expr(c, None) - // pInlineCommand använder nu forward-referensen pBodyRef - let pInlineCommand = - attempt (pchar '@' >>. many1Chars asciiLetter) - .>>. opt pArgs - .>>. opt pBody - |>> fun ((name, argsOpt), bodyOpt) -> + let pInlineCommand = + attempt (pchar '@' >>. many1Chars asciiLetter) .>>. opt pArgs .>>. opt pBody + |>> fun ((name, argsOpt), bodyOpt) -> let rawArgs = defaultArg argsOpt [] - let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None) - let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList - - // dedentNodes anropas här från Utils + let posArgs, kwargs = separateArgs rawArgs + // dedentNodes fixes indentation of inline commands spanning several lines let children = defaultArg bodyOpt [] |> Utils.dedentNodes - - Command(name, posArgs, kwargs, children) - // Nu när pInlineCommand, pExpr och pMultilineCode är definierade - // kan vi skapa pInnerInline + Command(name, posArgs, Map.ofList (kwargs), children) + + let pAtCommand = + pchar '@' + >>. choice + [ + // Matchar """ (Eftersom @ redan är konsumerat) + pstring "\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"") + |>> fun c -> Expr(c, None) + + // Matchar ( + pchar '(' >>. pParenBody .>> pchar ')' |>> fun c -> Expr(c, None) + + // Matchar ASCII-bokstäver (för kommandon) + many1Chars asciiLetter .>>. opt pArgs .>>. opt pBody + |>> fun ((name, argsOpt), bodyOpt) -> + let rawArgs = defaultArg argsOpt [] + let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None) + let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList + let children = defaultArg bodyOpt [] |> Utils.dedentNodes + Command(name, posArgs, kwargs, children) + + // Fallback: det var bara ett löst @ i texten + preturn (Text "@") ] + + // / Hjälpare för att bara svälja mellanslag och tabbar (inte radbrytningar) + let pHorizontalSpace = skipMany (anyOf " \t") + + let pCommandHead = pchar '@' >>. many1Chars (asciiLetter <|> digit) + + let pBlockCommand = + // 1. Tillåt indrag, men inga radbrytningar + pHorizontalSpace >>. pCommandHead .>>. opt pArgs .>>. opt pBody + + // 2. MAGIN: Se till att det inte finns mer text på raden efter kommandot + .>> pHorizontalSpace + .>> choice [ skipNewline; eof ] // Måste följas av radbrytning eller filslut + + |>> fun ((name, argsOpt), bodyOpt) -> + let args, kwargsList = separateArgs (defaultArg argsOpt []) + // Se till att eventuell dedent/städning appliceras här om du har Utils.dedentNodes + let children = defaultArg bodyOpt [] + + BlockCommand(name, args, Map.ofList kwargsList, children) + + let pInnerInline = - choice [ - attempt pInlineCommand - attempt pExpr - pMultilineCode - many1Chars (noneOf "@}") |>> Text - pchar '@' |>> fun _ -> Text "@" - ] + choice + [ pAtCommand // Hanterar alla @-baserade noder + many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt - // Tilldela värdet till pBodyRef pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline) - // Tilldela värdet till pInlineRef - pInlineRef.Value <- choice [ - pMultilineCode - pExpr - pInlineCommand - many1Chars (noneOf "@{}\n\r") |>> Text - attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" - pchar '@' |>> fun _ -> Text "@" - ] - + pInlineRef.Value <- + choice + [ pAtCommand + many1Chars (noneOf "@{}\n\r") |>> Text + attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ] // --- Block Parsers --- let pSectionBlock = + + let generateId title maybeid = + let extractIdFromTitle = + function + | Text(t) :: rest -> t.Substring(0, (min 20 t.Length)) + pseudoRandom.GetHexString(8) + | _ -> pseudoRandom.GetHexString(8) + + match maybeid with + | Some v -> v + | None -> extractIdFromTitle title + + let tryGetId args kwargs = + match args with + | [ id ] -> Some(id) + | _ -> alistGet kwargs "id" + attempt ( - pchar '@' >>. many1Chars asciiLetter >>= fun name -> - if isSection name then preturn name - else fail "Inte en sektion." - ) - .>>. opt pArgs + pchar '@' >>. many1Chars asciiLetter + >>= fun name -> + if isSection name then + preturn name + else + fail "Inte en sektion." + ) + .>>. opt pArgs .>>. opt pBody |>> fun ((name, argsOpt), bodyOpt) -> - Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt []) + let title = defaultArg bodyOpt [] + let posArgs, kwargs = separateArgs (defaultArg argsOpt []) + let id = tryGetId posArgs kwargs |> generateId title + let attrs = { id = id; classes = []; kvp = kwargs } + + // There are no children in this section yet, since we slurp the children once the + // AST parsing is done + Section(attrs, getSectionLevel name, title, []) let pParagraphBlock = many1 pInline |>> Paragraph - let pBlock = choice [ pSectionBlock; pParagraphBlock ] + let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ] - // --- Dokument Parser --- - let pDocument = - spaces + let pDocument = + spaces >>. opt ( - pstring "---" - >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---")) - |>> fun yamlStr -> + pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---")) + |>> fun yamlStr -> let deserializer = DeserializerBuilder().Build() let dict = deserializer.Deserialize>(yamlStr) - if isNull dict then Map.empty - else dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq - ) - .>> spaces + + if isNull dict then + Map.empty + else + dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq + ) + .>> spaces .>>. sepEndBy pBlock (many1 pNewline) .>> eof - |>> fun (headerOpt, blocks) -> - (defaultArg headerOpt Map.empty, blocks) + |>> fun (headerOpt, blocks) -> (defaultArg headerOpt Map.empty, blocks) - let parse i = - match run pDocument i with - | Success(r, _, _) -> r + let parse i = + match run pDocument i with + | Success(r, _, _) -> r | Failure(e, _, _) -> failwith e -// ========================================== -// 3. Execution & Printer -// ========================================== -type IEvaluator = +[] +type IEvaluator() = abstract member Evaluate: string -> string - -module Execution = - open Ast - - let rec transform (metadata: Map) (prelude: Map) (eval: IEvaluator) = function - | Command(name, args, kwargs, children) when prelude.ContainsKey name -> - prelude.[name] metadata args kwargs (children |> List.map (transform metadata prelude eval)) - | Command(n, _, _ ,_) -> failwithf "%s is not a defined command" n - | Expr(c, _) -> RawHtml (eval.Evaluate c) - | n -> n - - - + abstract member NewSession: unit -> unit module Evaluators = open System.IO open System.Text open FSharp.Compiler.Interactive.Shell + type NullEvaluator() = + inherit IEvaluator() + override this.Evaluate(code: string) = "" + override this.NewSession() = () + + + type FsiEvaluator() = + inherit IEvaluator() let sbOut = StringBuilder() - let sbErr = StringBuilder() + let sbErr = StringBuilder() let inStream = new StringReader("") let outStream = new StringWriter(sbOut) let errStream = new StringWriter(sbErr) @@ -334,62 +437,180 @@ module Evaluators = // Initiera FSI-sessionen let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration() let argv = [| "fsi.exe"; "--noninteractive" |] - let session = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream) - interface IEvaluator with - member _.Evaluate(code: string) = - sbOut.Clear() |> ignore - sbErr.Clear() |> ignore + let session = + FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream) - try - let result, _warnings = session.EvalInteractionNonThrowing(code) + override this.Evaluate(code: string) = + sbOut.Clear() |> ignore + sbErr.Clear() |> ignore - let output = sbOut.ToString() - let errors = sbErr.ToString().Trim() + try + let result, _warnings = session.EvalInteractionNonThrowing(code) - // Filtrera bort FSI:s automatiska typsignaturer från utskriften - let cleanOutput = - output.Replace("\r\n", "\n").Split('\n') - |> Array.filter (fun line -> - let l = line.TrimStart() - not (l.StartsWith("val ") || l.StartsWith("type ") || l.StartsWith("module ") || l.StartsWith("namespace ")) - ) - |> String.concat "\n" - |> fun s -> s.Trim() + let output = sbOut.ToString() + let errors = sbErr.ToString().Trim() - match result with - | Choice1Of2 (Some fsiValue) -> - // Plocka ut värdet. Om det är en sträng, undvik "%A" för att slippa citattecken. - let valStr = - if isNull fsiValue.ReflectionValue then "" - else - match fsiValue.ReflectionValue with - | :? string as s -> s - | v -> sprintf "%A" v - - if System.String.IsNullOrEmpty(cleanOutput) then valStr - elif System.String.IsNullOrEmpty(valStr) then cleanOutput - else cleanOutput + "\n" + valStr - - | Choice1Of2 None -> - if not (System.String.IsNullOrEmpty(errors)) then - cleanOutput + sprintf "%A" errors + // Filtrera bort FSI:s automatiska typsignaturer från utskriften + let cleanOutput = + output.Replace("\r\n", "\n").Split('\n') + |> Array.filter (fun line -> + let l = line.TrimStart() + + not ( + l.StartsWith("val ") + || l.StartsWith("type ") + || l.StartsWith("module ") + || l.StartsWith("namespace ") + )) + |> String.concat "\n" + |> fun s -> s.Trim() + + match result with + | Choice1Of2(Some fsiValue) -> + // Plocka ut värdet. Om det är en sträng, undvik "%A" för a tattecken. + let valStr = + if isNull fsiValue.ReflectionValue then + "" else - cleanOutput - - | Choice2Of2 ex -> - let fsiErrorOutput = if System.String.IsNullOrEmpty(errors) then "Ingen ytterligare FSI-output." else errors - sprintf """ -
    - FSI Exekveringsfel!
    - Kod som kördes: %s

    - Exception: %s
    - FSI Stderr: 
    %s
    -
    """ code ex.Message fsiErrorOutput - - with ex -> - sprintf """
    - Kritiskt FSI-systemfel: %s -
    """ ex.Message + match fsiValue.ReflectionValue with + | :? string as s -> s + | v -> sprintf "%A" v - + if System.String.IsNullOrEmpty(cleanOutput) then valStr + elif System.String.IsNullOrEmpty(valStr) then cleanOutput + else cleanOutput + "\n" + valStr + + | Choice1Of2 None -> + if not (System.String.IsNullOrEmpty(errors)) then + cleanOutput + sprintf "%A" errors + else + cleanOutput + + | Choice2Of2 ex -> + let fsiErrorOutput = + if System.String.IsNullOrEmpty(errors) then + "Ingen ytterligare FSI-output." + else + errors + + sprintf + """ +
    + FSI Exekveringsfel!
    + Kod som kördes: %s

    + Exception: %s
    + FSI Stderr: 
    %s
    +
    """ + code + ex.Message + fsiErrorOutput + + with ex -> + sprintf + """
    + Kritiskt FSI-systemfel: %s +
    """ + ex.Message + + override this.NewSession() = + this.Evaluate($"module {Random.Shared.GetHexString(10)}") + () + + + +module CommandEvaluator = + open Ast + // Interface för att utvärdera Expr-noder (kodblock/matte) + + // Huvudfunktionen + let rec evaluateDocument + (metadata: Map) + (prelude: Map) + (exprEval: IEvaluator) + (blocks: BlockNode list) + = + blocks |> List.map (evaluateBlock metadata prelude exprEval) + + // Evaluerar Block-noder + and evaluateBlock metadata prelude exprEval block = + let evalBlocks = evaluateDocument metadata prelude exprEval + let evalInlines = List.map (evaluateInline metadata prelude exprEval) + + match block with + | CodeBlock(attr, text) -> CodeBlock(attr, text) + + | Figure(attr, caption, blocks) -> Figure(attr, evalInlines caption, evalBlocks blocks) + + | Plain inlines -> Plain(evalInlines inlines) + + | Paragraph inlines -> Paragraph(evalInlines inlines) + + | Section(attr, lvl, title, body) -> Section(attr, lvl, evalInlines title, evalBlocks body) + + | ListBlock kind -> + match kind with + | Orderedlist(attr, start, blocksList) -> + Orderedlist(attr, start, blocksList |> List.map evalBlocks) |> ListBlock + | BulletList(attr, blocksList) -> BulletList(attr, blocksList |> List.map evalBlocks) |> ListBlock + // TODO: This should run recursively to make sure a command can return a new command! + | BlockCommand(name, args, kwargs, children) -> + let evalChildren = children |> List.map (evaluateInline metadata prelude exprEval) + + match prelude.TryFind name with + | Some renderer -> + // Om du ändrar TagRenderer att returnera BlockNode direkt är det ännu bättre. + match renderer metadata args kwargs evalChildren with + | Block i -> i // Exempel: @table blev en riktig Table-nod + | Inline i -> Plain [ i ] + | None -> failwithf "Okänt block-kommando: %s" name + + // Evaluerar Inline-noder + and evaluateInline metadata prelude exprEval inlineNode = + let evalInlines = List.map (evaluateInline metadata prelude exprEval) + let evalBlocks = evaluateDocument metadata prelude exprEval + + match inlineNode with + // Noder som inte har några barn eller commands i sig + | Text _ + | RawHtml _ + | SoftBreak + | LineBreak -> inlineNode + + // Enkla wrappers som bara skickar vidare barnen + | Emph children -> Emph(evalInlines children) + | Underline children -> Underline(evalInlines children) + | Strong children -> Strong(evalInlines children) + | Strikeout children -> Strikeout(evalInlines children) + | Superscript children -> Superscript(evalInlines children) + | Subscript children -> Subscript(evalInlines children) + + // Komplexa noder + | Link(attr, target) -> + let url, content = target + Link(attr, (url, evalInlines content)) + + | Image(attr, altText, url) -> Image(attr, evalInlines altText, url) + + | Code(attr, text) -> Code(attr, text) + + | Note blocks -> + // Här går vi tillbaka till att evaluera block! + Note(evalBlocks blocks) + + | Expr(code, res) -> Expr(code, Some(exprEval.Evaluate code)) + + // TODO: This should run recursively to make sure a command can return a new command! + | Command(tag, args, kwargs, children) -> + // 1. Evaluera barnen först (Bottom-Up) + let evaluatedChildren = evalInlines children + + // 2. Slå upp kommandot i preluden + match prelude.TryFind tag with + | Some renderer -> + // 3. Kör funktionen och returnera den nya noden + match renderer metadata args kwargs evaluatedChildren with + | Inline i -> i + | Block b -> failwithf "Syntaxfel: Blocknod i inline-kontext: %A" b + + | None -> failwithf "Syntaxfel: Okänt kommando '@%s' hittades under evaluering." tag diff --git a/src/FibLib/Pandoc.fs b/src/FibLib/Pandoc.fs index 0df9736..f85d610 100644 --- a/src/FibLib/Pandoc.fs +++ b/src/FibLib/Pandoc.fs @@ -7,14 +7,16 @@ module Pandoc = open System.Diagnostics let toHtml (from: string) (markdownText: string) = - let startInfo = ProcessStartInfo( - FileName = "pandoc", - Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua", - RedirectStandardInput = true, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) + let startInfo = + ProcessStartInfo( + FileName = "pandoc", + Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua", + RedirectStandardInput = true, + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true + ) try use proc = Process.Start startInfo @@ -25,20 +27,21 @@ module Pandoc = // Läs ut resultatet let htmlOutput = proc.StandardOutput.ReadToEnd() let errorOutput = proc.StandardError.ReadToEnd() - - - + + + proc.WaitForExit() Console.WriteLine(htmlOutput) + if proc.ExitCode = 0 then htmlOutput.Trim() else sprintf "\n
    %s
    and 
    %s
    " errorOutput markdownText - + with ex -> // Fångar upp om Pandoc inte är installerat eller inte finns i PATH sprintf "\n
    %s
    and 
    %s
    " ex.Message markdownText let mdToHtml markdownText = - let res= toHtml "markdown" markdownText + let res = toHtml "markdown" markdownText res diff --git a/src/FibLib/constructorHelpers.fs b/src/FibLib/constructorHelpers.fs index 2b57d06..5c484e4 100644 --- a/src/FibLib/constructorHelpers.fs +++ b/src/FibLib/constructorHelpers.fs @@ -1,28 +1,50 @@ namespace Fibble.FibLib -open FSharp.Compiler.Text open Fibble.FibLib.Ast module Helpers = - let emptyAttr ={id=""; classes=[]; kvp=[]} - let ah cls kvp = - {id=""; classes = [cls]; kvp = Map.toList kvp } + let emptyAttr = { id = ""; classes = []; kvp = [] } + + let ah cls kvp = + { id = "" + classes = [ cls ] + kvp = Map.toList kvp } + let onlyChildren constructor : TagRenderer = - fun _ _ _ children -> constructor(children) + fun _ _ _ children -> Inline(constructor (children)) + + let makeAttr kwargs = + let id = defaultArg (Map.tryFind "id" kwargs) "" + + let classes = + match Map.tryFind "class" kwargs with + | Some v -> v.Split "," |> Array.toList + | None -> [] + + let rest = + Map.toList kwargs + |> List.filter (fun p -> not (List.contains (fst p) [ "id"; "class" ])) + + { id = id + classes = classes + kvp = rest } + + + open Helpers module ConstructionHelpers = - let linebreak _ _ _ _ = LineBreak - let softbreak _ _ _ _ = SoftBreak - - let value : TagRenderer = + let linebreak _ _ _ _ = Inline(LineBreak) + let softbreak _ _ _ _ = Inline(SoftBreak) + + let value: TagRenderer = fun meta args _ _ -> match Map.tryFind args.Head meta with - | Some(v) -> Text v - | None -> Text $"value {args.Head} not found in metadata" - - + | Some v -> Inline(Text v) + | None -> Inline(Text $"value {args.Head} not found in metadata") + + let emph = onlyChildren Emph let underline = onlyChildren Underline let strong = onlyChildren Strong @@ -30,24 +52,39 @@ module ConstructionHelpers = let superscript = onlyChildren Superscript let subscript = onlyChildren Subscript - let image : TagRenderer = + let image: TagRenderer = fun _ args kwargs children -> let attributes = ah "inlineImage" kwargs - Image(attributes,children, args[0]) - let code : TagRenderer = + Inline(Image(attributes, children, args[0])) + + let code: TagRenderer = fun _ _ kwargs children -> let attributes = ah "inlineCode" kwargs + match children with - | [Text(c)] -> InlineNode.Code(attributes, c) - | _ -> failwith "Code tag was not Text," - - let link : TagRenderer = + | [ Text(c) ] -> Inline(InlineNode.Code(attributes, c)) + | _ -> failwith "Code tag was not Text," + + let link: TagRenderer = fun _ args kwargs children -> let attributes = ah "link" kwargs - Link(attributes,Target(args[0], children)) + Inline(Link(attributes, Target(args[0], children))) + + - - // blocks let paragraph _ _ _ children = Paragraph(children) let plain _ _ _ children = Plain(children) + + let table _ args kwargs children = + let rows = + children + |> AstUtils.splitByNewlines + |> List.map (fun rowNodes -> + + let cells = rowNodes |> AstUtils.splitByPipe |> List.map Cell // Wrap each split list in a Cell node + + Row cells) + + let attr = makeAttr kwargs + Block(Table(attr, rows))