Compare commits

...

3 commits

Author SHA1 Message Date
c3f2f98dc8 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.
2026-04-02 10:06:59 +02:00
f1fefece72 merge remote 2026-04-01 08:57:37 +02:00
6e26f37759 Changed name of rawhtml 2026-04-01 08:52:00 +02:00
11 changed files with 875 additions and 404 deletions

6
Fibble.slnx Normal file
View file

@ -0,0 +1,6 @@
<Solution>
<Folder Name="/src/">
<Project Path="src/Bif/Bif.fsproj" />
<Project Path="src/FibLib/FibLib.fsproj" />
</Folder>
</Solution>

View file

@ -7,6 +7,9 @@
<ItemGroup> <ItemGroup>
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
<Content Include="document.fib" />
<Content Include="strip-p.lua" />
<Content Include="_page-template" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

View file

@ -1,46 +1,31 @@
open System.Net open System.IO
open System.IO
open System.Runtime.CompilerServices
open FSharp.Compiler.Text
open Fibble.FibLib open Fibble.FibLib
open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc. open Fibble.FibLib.Ast
open Fibble.FibLib.Pandoc
open Fibble.FibLib.HtmlPrinter open Fibble.FibLib.HtmlPrinter
open Fibble.FibLib.Utils
open Fibble.FibLib.ConstructionHelpers open Fibble.FibLib.ConstructionHelpers
// ==========================================
// 1. Prelude (Dina egna taggar)
// ==========================================
let myPrelude: Map<string, TagRenderer> =
let myPrelude : Map<string, TagRenderer> = Map
Map [ [ "quotient",
"quotient", fun _ args _ _ -> fun _ args _ _ ->
match args with match args with
| [one; two] -> | [ one; two ] -> Inline(Text(sprintf "%d" (int one / int two)))
Text (sprintf "%d" (int one / int two)) | _ -> Inline(Text "[Fel: quotient kräver två argument]")
| _ -> "bold", fun _ _ _ children -> Inline(Strong(children))
Text "[Fel: quotient kräver två argument]" "kursiv", fun _ _ _ children -> Inline(Emph(children))
"bold", fun _ _ _ children ->
Strong(children)
"kursiv", fun _ _ _ children -> Emph(children)
"image", image "image", image
"value", value "value", value
"link", link "link", link
"list", fun _ _ _ c -> System.Console.WriteLine(c) "list",
RawHtml "hej" fun _ _ _ c ->
System.Console.WriteLine(c)
// @br har varken argument eller barn, vi returnerar bara HTML direkt Inline(RawHtml "hej")
"br", linebreak "br", linebreak
"table", fun _ _ _ children -> Text "hej" "table", table
"md", fun _ _ _ children -> RawHtml (mdToHtml (stringifyNodes children))
] "md", fun _ _ _ _ -> Inline(Text "hej") ]
// ==========================================
// 2. Mall och Evaluator
// ==========================================
//
module File = module File =
let readFile path = let readFile path =
match Path.Exists(path) with match Path.Exists(path) with
@ -50,31 +35,21 @@ module File =
let pageTemplate = File.readFile "_page-template" let pageTemplate = File.readFile "_page-template"
let sourceCode = File.readFile "document.fib" let sourceCode = File.readFile "document.fib"
// ==========================================
// 3. Huvudpipeline
// ==========================================
let processDocument (source: string) = let processDocument (source: string) =
let evaluator = Evaluators.FsiEvaluator() let evaluator = Evaluators.NullEvaluator()
// Steg 1: Parsa koden // Parsa koden
let metadata, rawBlocks = Parser.parse source let metadata, raewBlocks = Parser.parse source
let rawBlocks = AstUtils.slurpSections raewBlocks
// Steg 2: Transformera och exekvera trädet
let evaluatedBlocks = let evaluatedBlocks =
rawBlocks |> List.map (function CommandEvaluator.evaluateDocument metadata myPrelude evaluator rawBlocks
| 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"
) // Be printern skriva ut trädet till HTML
let bodyHtml = HtmlWriter.renderDocument evaluatedBlocks
// Steg 3: Be printern skriva ut trädet till HTML
let bodyHtml = HtmlPrinter.render evaluatedBlocks
// Steg 4: Fyll i din HTML-mall // Steg 4: Fyll i din HTML-mall
let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml) let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml)

53
src/Bif/_page-template Normal file
View file

@ -0,0 +1,53 @@
<!DOCTYPE html>
<htm>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta http-equiv="Content-Style-Type" content="text/css" />
<meta name="viewport" content="initial-scale=1,maximum-scale=1" />
<link rel="stylesheet" type="text/css" href="/_resources/min.css">
<title>{{title}}</title>
</head>
<body>
<nav class="nav" id="nav">
<div class="container">
<a class="pagename current" href="/"><img src="/_resources/icons/go-home.svg.png"/>Home</a>
<a href="."><img src="/_resources/icons/go-up.svg.png"/>Up</a>
<a href="/om/"><img src="/_resources/icons/help-contents.svg.png"/>About and Credits</a>
</div>
</nav>
<a href="#nav" class="btn-nav"></a>
<a href="#close" class="btn btn-sm btn-close">×</a>
<div class="container">
<h1 class="title">{{title}}</h1>
<div class="dateandauthor">
<span class="author">by {{author}}</span>
<span class="date">{{date}}</span>
</div>
<hr/>
{{body}}
<!-- FOOTER -->
<hr/>
<div class="footer">
All images (except icons) are, unless otherwise specified, in the public domain. For the rest of the content, the following apply: <br/>
<div class="cclicence">
<div class="licence-image">
<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">
<img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by-sa/4.0/88x31.png" />
</a>
</div>
<div class="licence-text">
This work by <a xmlns:cc="http://creativecommons.org/ns#" href="mailto:berglund_linus@fastmail.se" property="cc:attributionName" rel="cc:attributionURL">Linus Björstam</a> is licensed under a <a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">Creative Commons Attribution-ShareAlike 4.0 International License</a>.
</div>
</div>
</div>
</div><!-- end class container -->
</body>
</html>

View file

@ -6,44 +6,10 @@ title: FSI Test
@section{Definitioner} @section{Definitioner}
Vi definierar en funktion och en variabel. Vi definierar en funktion och en variabel.
@"""
let globalCounter = ref 0
let increment () = @table{
globalCounter.Value <- globalCounter.Value + 1 rubrik 1 | rubrik 2
sprintf "Räknaren är nu %d" globalCounter.Value 1 | 3
""" 2 | 4
@(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
} }
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]

115
src/FibLib/AstUtils.fs Normal file
View file

@ -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 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 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 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å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 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)
)

View file

@ -8,6 +8,7 @@
<ItemGroup> <ItemGroup>
<Compile Include="Pandoc.fs" /> <Compile Include="Pandoc.fs" />
<Compile Include="Library.fs" /> <Compile Include="Library.fs" />
<Compile Include="AstUtils.fs" />
<Compile Include="constructorHelpers.fs" /> <Compile Include="constructorHelpers.fs" />
<Compile Include="HtmlPrinter.fs" /> <Compile Include="HtmlPrinter.fs" />
</ItemGroup> </ItemGroup>

View file

@ -4,60 +4,151 @@ module Fibble.FibLib.HtmlPrinter
open System.Net open System.Net
module HtmlPrinter = module HtmlWriter =
open Ast 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 "<strong>%s</strong>" (renderAll t)
| RawHtml h ->
h
| _ -> ""
let renderFigure a c l = // --- HJÄLPARFUNKTIONER ---
failwith "haha"
let renderListItem item = let escapeHtml (text: string) =
sprintf "<li>%s</li>" item if System.String.IsNullOrEmpty(text) then
""
else
WebUtility.HtmlEncode(text)
let renderList kind attributes nodesList = // Plockar ut ren text för attribut som alt-texter där vi inte får ha HTML-taggar
let content = nodesList let rec extractText (nodes: InlineNode list) =
|> List.map renderListItem
|> String.concat "\n"
$"<{kind} {(renderAttributes attributes)}>{content}</{kind}>"
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 nodes
|> List.choose (function RawHtml h -> Some h | _ -> None) |> List.map (function
|> String.concat "\n" | Text t -> t
| Paragraph c -> sprintf "<p>%s</p>" (c |> List.map renderInline |> String.concat "") | RawHtml h -> h
| Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l | Emph c
| CodeBlock(attributes, text) -> sprintf "<code>%s</code>" text | Underline c
| Figure(attributes, caption, blocks) -> renderFigure attributes caption blocks | Strong c
| ListBlock(l) -> match l with | Strikeout c
| BulletList(attr, blocknodes) -> renderList "ul" attr.kvp (doubleRender blocknodes) | Superscript c
| Orderedlist(attr, start, blocknodes) -> renderList "ol" attr.kvp (doubleRender blocknodes) | Subscript c -> extractText c
| Plain nodes -> List.map renderInline nodes |> String.concat " " | Link(_, (_, c)) -> extractText c
blocks | Code(_, t) -> t
|> List.map renderNode | _ -> "")
|> String.concat "\n" |> 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 "<p>%s</p>\n" (renderInlines children)
| Plain inlines -> sprintf "%s\n" (renderInlines inlines)
| CodeBlock(attr, text) -> sprintf "<pre><code%s>%s</code></pre>\n" (renderAttr attr) (escapeHtml text)
| Figure(attr, caption, blocks) ->
let bodyHtml = blocks |> List.map renderBlock |> String.concat ""
let captionHtml = renderInlines caption
sprintf "<figure%s>\n%s<figcaption>%s</figcaption>\n</figure>\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 "<section%s>\n<h%d>%s</h%d>\n%s</section>\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 "<li>%s</li>\n" (b |> List.map renderBlock |> String.concat ""))
|> String.concat ""
sprintf "<ol%s%s>\n%s</ol>\n" (renderAttr attr) startAttr itemsHtml
| BulletList(attr, blocksList) ->
let itemsHtml =
blocksList
|> List.map (fun b -> sprintf "<li>%s</li>\n" (b |> List.map renderBlock |> String.concat ""))
|> String.concat ""
sprintf "<ul%s>\n%s</ul>\n" (renderAttr attr) itemsHtml
| Table(attr, rows) ->
let renderedRows = List.map renderRow rows |> String.concat " "
sprintf "<table%s>%s</table>" (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 "<em>%s</em>" (renderInlines c)
| Strong c -> sprintf "<strong>%s</strong>" (renderInlines c)
| Underline c -> sprintf "<u>%s</u>" (renderInlines c)
| Strikeout c -> sprintf "<s>%s</s>" (renderInlines c)
| Superscript c -> sprintf "<sup>%s</sup>" (renderInlines c)
| Subscript c -> sprintf "<sub>%s</sub>" (renderInlines c)
// Länkar och bilder
| Link(attr, (url, content)) -> sprintf "<a href=\"%s\"%s>%s</a>" url (renderAttr attr) (renderInlines content)
| Image(attr, altText, url) ->
// Bild-alt måste vara ren text (får ej innehålla <em>, <strong> etc)
let cleanAlt = extractText altText |> escapeHtml
sprintf "<img src=\"%s\" alt=\"%s\"%s />" url cleanAlt (renderAttr attr)
| Code(attr, text) -> sprintf "<code%s>%s</code>" (renderAttr attr) (escapeHtml text)
| SoftBreak -> "\n"
| LineBreak -> "<br />"
| Expr(_, resultOpt) -> resultOpt |> Option.defaultValue ""
| Note _ ->
// Fotnoter renderas oftast som en ankarlänk här, och själva innehållet längst ner sidan.
// (Detta kan vi implementera senare när du bygger det globala state-systemet)
"<sup><a href=\"#footnote\">[ref]</a></sup>"
| 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 "<td>%s</td>" (renderInlines children)
List.map renderedCell cells |> String.concat "" |> sprintf "<tr>%s</tr>\n"

View file

@ -1,6 +1,7 @@
namespace Fibble.FibLib namespace Fibble.FibLib
open System.Net
open System
open FParsec open FParsec
open YamlDotNet.Serialization open YamlDotNet.Serialization
open System.Collections.Generic open System.Collections.Generic
@ -11,7 +12,10 @@ open System.Collections.Generic
// ========================================== // ==========================================
module Ast = 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 = type InlineNode =
@ -31,62 +35,82 @@ module Ast =
| LineBreak | LineBreak
| Expr of code: string * result: string option | Expr of code: string * result: string option
| Command of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list | Command of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list
and BlockNode = and BlockNode =
| BlockCommand of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list
| CodeBlock of attributes: Attr * text: string | 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 | ListBlock of ListKind
| Plain of InlineNode list | Plain of InlineNode list
| Paragraph of children: InlineNode list | Paragraph of children: InlineNode list
| Section of level: int * args: (string * string) list * children: InlineNode list | 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 = and ListKind =
| Orderedlist of attributes: Attr * start: int * blocksList: (BlockNode list) list | Orderedlist of attributes: Attr * start: int * blocksList: (BlockNode list) list
| BulletList of attributes: Attr * blocksList: (BlockNode list) list | BulletList of attributes: Attr * blocksList: (BlockNode list) list
and Url = string and Url = string
and Target = Url * InlineNode list and Target = Url * InlineNode list
type Document = BlockNode list type Document = BlockNode list
type TagRenderer = Map<string,string> type TocEntry =
-> string list | TocGroup of title: string * id: string * children: TocEntry list
-> Map<string,string> | TocEntity of title: string * id: string
-> InlineNode list -> InlineNode
type NextDocument =
{ document: BlockNode list
Toc: TocEntry list
Footnotes: BlockNode list list
Metadata: Map<string, string> }
type NodeResult =
| Inline of InlineNode
| Block of BlockNode
type TagRenderer = Map<string, string> -> string list -> Map<string, string> -> 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 = module Utils =
open Ast open Ast
let dedentNodes (nodes: InlineNode list) = let dedentNodes (nodes: InlineNode list) =
let fullText = let fullText =
nodes |> List.choose (function Text t -> Some t | _ -> None) |> String.concat "" nodes
|> List.choose (function
| Text t -> Some t
| _ -> None)
|> String.concat ""
let lines = fullText.Replace("\r\n", "\n").Split('\n') 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) // 1. Räkna BARA ut minIndent från rader som kommer efter en radbrytning (skippa rad 0)
let minIndent = let minIndent =
if lines.Length <= 1 then 0 if lines.Length <= 1 then
0
else else
lines |> Array.skip 1 lines
|> Array.skip 1
|> Array.filter (fun l -> not (System.String.IsNullOrWhiteSpace(l))) |> Array.filter (fun l -> not (System.String.IsNullOrWhiteSpace(l)))
|> Array.map (fun l -> l.Length - l.TrimStart().Length) |> 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 mutable isFirstText = true
let indentStr = "\n" + String.replicate minIndent " " let indentStr = "\n" + String.replicate minIndent " "
// 2. Applicera formateringen // 2. Applicera formateringen
let dedented = let dedented =
nodes |> List.map (function nodes
|> List.map (function
| Text t -> | Text t ->
let t1 = t.Replace("\r\n", "\n") let t1 = t.Replace("\r\n", "\n")
@ -95,22 +119,28 @@ module Utils =
if isFirstText then if isFirstText then
isFirstText <- false isFirstText <- false
t1.TrimStart(' ', '\t') t1.TrimStart(' ', '\t')
else t1 else
t1
// Ta bort minIndent antal mellanslag efter varje radbrytning i noden // Ta bort minIndent antal mellanslag efter varje radbrytning i noden
let t3 = if minIndent > 0 then t2.Replace(indentStr, "\n") else t2 let t3 = if minIndent > 0 then t2.Replace(indentStr, "\n") else t2
Text t3 Text t3
| otherNode -> otherNode | otherNode -> otherNode)
)
// 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna // 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna
let rec trimStart = function let rec trimStart =
function
| Text t :: rest -> | Text t :: rest ->
let trimmed = t.TrimStart('\n', '\r', ' ', '\t') 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 | other -> other
let rec trimEnd = function let rec trimEnd =
function
| Text t :: rest -> | Text t :: rest ->
let trimmed = t.TrimEnd('\n', '\r', ' ', '\t') let trimmed = t.TrimEnd('\n', '\r', ' ', '\t')
if trimmed = "" then trimEnd rest else Text trimmed :: rest if trimmed = "" then trimEnd rest else Text trimmed :: rest
@ -118,27 +148,36 @@ module Utils =
dedented |> trimStart |> List.rev |> trimEnd |> List.rev dedented |> trimStart |> List.rev |> trimEnd |> List.rev
let positional f: TagRenderer = let positional f : TagRenderer =
fun _ (args: string list) _ children -> f args children fun _ (args: string list) _ children -> f args children
let onlyArgs f = let onlyArgs f =
fun _ args kwargs children -> f args kwargs 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 = "") 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 // 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) = let getArg (args: (string * string) list) (key: string) (index: int) (defaultVal: string) =
match args |> List.tryFind (fun (k, _) -> k = key) with match args |> List.tryFind (fun (k, _) -> k = key) with
| Some (_, v) -> v.Trim('"') | Some(_, v) -> v.Trim('"')
| None -> getArgIdx args index defaultVal | None -> getArgIdx args index defaultVal
let withArg1 def (f: string -> InlineNode list -> InlineNode) = let withArg1 def (f: string -> InlineNode list -> InlineNode) =
fun _ args children -> f (getArgIdx args 0 def) children 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 fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children
@ -150,14 +189,30 @@ module Utils =
module Parser = module Parser =
open Ast open Ast
let pseudoRandom = new System.Random()
let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit>() let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit> ()
let getSectionLevel (name: string) = let getSectionLevel (name: string) =
if name = "section" then 1 if name = "section" then
elif name = "subsection" then 2 1
elif name.StartsWith("sub") && name.EndsWith("section") then (name.Length - 7) / 3 + 1 elif name = "subsection" then
else 1 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 isSection (name: string) = name.EndsWith("section")
@ -165,14 +220,18 @@ module Parser =
let pNamedArg = let pNamedArg =
// Leta efter "nyckel=värde" // Leta efter "nyckel=värde"
attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_") attempt (
.>> spaces .>> pchar '=' .>> spaces) many1Chars (asciiLetter <|> digit <|> anyOf "-_")
.>> spaces
.>> pchar '='
.>> spaces
)
.>>. manyChars (noneOf ",]") .>>. manyChars (noneOf ",]")
|>> fun (k, v) -> (k, v.Trim()) |>> fun (k, v) -> k, v.Trim()
let pPositionalArg = let pPositionalArg =
// Bara "värde" // Bara "värde"
manyChars (noneOf ",]") |>> fun v -> ("", v.Trim()) manyChars (noneOf ",]") |>> fun v -> "", v.Trim()
let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces
@ -180,119 +239,169 @@ module Parser =
between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ',')) between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ','))
>>= fun args -> >>= fun args ->
// Validera att positionella argument alltid kommer först // 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 | [] -> preturn args // Allt är okej, returnera listan
| ("", _) :: tail -> | ("", _) :: tail ->
if not canBePositional then if not canBePositional then
fail "Syntaxfel: Positionella argument får inte komma efter namngivna argument." fail "Syntaxfel: Positionella argument får inte komma efter namngivna argument."
else validate true tail else
| _ :: tail -> validate true tail
validate false tail | _ :: tail -> validate false tail
validate true args validate true args
// --- 1. Måsvinge-parser (för @kommandon) ---
// Lägg till en referens för pBody högst upp bland dina referenser let pBody, pBodyRef = createParserForwardedToRef<InlineNode list, unit> ()
// (Bör ligga precis under let pInline, pInlineRef = ...)
let pBody, pBodyRef = createParserForwardedToRef<InlineNode list, unit>()
// --- 2. Parentes-parser (för @(...) med sträng-stöd) --- // --- 2. Parentes-parser (för @(...) med sträng-stöd) ---
let pParenBody, pParenBodyRef = createParserForwardedToRef<string, unit>() let pParenBody, pParenBodyRef = createParserForwardedToRef<string, unit> ()
let pFSharpString = let pFSharpString =
let normal = many1Chars (noneOf "\"\\") let normal = many1Chars (noneOf "\"\\")
let escaped = pstring "\\" >>. anyChar |>> sprintf "\\%c" let escaped = pstring "\\" >>. anyChar |>> sprintf "\\%c"
pstring "\"" .>>. manyStrings (normal <|> escaped) .>>. pstring "\"" pstring "\"" .>>. manyStrings (normal <|> escaped) .>>. pstring "\""
|>> fun ((start, inner), end_) -> start + inner + end_ |>> fun ((start, inner), end_) -> start + inner + end_
pParenBodyRef.Value <- pParenBodyRef.Value <-
manyStrings (choice [ manyStrings (
pFSharpString choice
[ pFSharpString
many1Chars (noneOf "()\"") many1Chars (noneOf "()\"")
pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" ]
]) )
let pExpr = let pExpr =
attempt (pstring "@(") >>. pParenBody .>> pstring ")" attempt (pstring "@(") >>. pParenBody .>> pstring ")" |>> fun c -> Expr(c, None)
|>> fun c -> Expr(c, None)
// --- Övriga inline-parsers --- // --- Övriga inline-parsers ---
let pMultilineCode =
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"") let pInlineCommand =
attempt (pchar '@' >>. many1Chars asciiLetter) .>>. opt pArgs .>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) ->
let rawArgs = defaultArg argsOpt []
let posArgs, kwargs = separateArgs rawArgs
// dedentNodes fixes indentation of inline commands spanning several lines
let children = defaultArg bodyOpt [] |> Utils.dedentNodes
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) |>> fun c -> Expr(c, None)
// pInlineCommand använder nu forward-referensen pBodyRef // Matchar (
let pInlineCommand = pchar '(' >>. pParenBody .>> pchar ')' |>> fun c -> Expr(c, None)
attempt (pchar '@' >>. many1Chars asciiLetter)
.>>. opt pArgs // Matchar ASCII-bokstäver (för kommandon)
.>>. opt pBody many1Chars asciiLetter .>>. opt pArgs .>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) -> |>> fun ((name, argsOpt), bodyOpt) ->
let rawArgs = defaultArg argsOpt [] let rawArgs = defaultArg argsOpt []
let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None) 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 kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList
// dedentNodes anropas här från Utils
let children = defaultArg bodyOpt [] |> Utils.dedentNodes let children = defaultArg bodyOpt [] |> Utils.dedentNodes
Command(name, posArgs, kwargs, children) Command(name, posArgs, kwargs, children)
// Nu när pInlineCommand, pExpr och pMultilineCode är definierade // Fallback: det var bara ett löst @ i texten
// kan vi skapa pInnerInline preturn (Text "@") ]
let pInnerInline =
choice [ // / Hjälpare för att bara svälja mellanslag och tabbar (inte radbrytningar)
attempt pInlineCommand let pHorizontalSpace = skipMany (anyOf " \t")
attempt pExpr
pMultilineCode let pCommandHead = pchar '@' >>. many1Chars (asciiLetter <|> digit)
many1Chars (noneOf "@}") |>> Text
pchar '@' |>> fun _ -> Text "@" 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 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
[ 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) pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline)
// Tilldela värdet till pInlineRef pInlineRef.Value <-
pInlineRef.Value <- choice [ choice
pMultilineCode [ pAtCommand
pExpr
pInlineCommand
many1Chars (noneOf "@{}\n\r") |>> Text many1Chars (noneOf "@{}\n\r") |>> Text
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ]
pchar '@' |>> fun _ -> Text "@"
]
// --- Block Parsers --- // --- Block Parsers ---
let pSectionBlock = 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 ( attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name -> pchar '@' >>. many1Chars asciiLetter
if isSection name then preturn name >>= fun name ->
else fail "Inte en sektion." if isSection name then
preturn name
else
fail "Inte en sektion."
) )
.>>. opt pArgs .>>. opt pArgs
.>>. opt pBody .>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) -> |>> 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 pParagraphBlock = many1 pInline |>> Paragraph
let pBlock = choice [ pSectionBlock; pParagraphBlock ] let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ]
// --- Dokument Parser ---
let pDocument = let pDocument =
spaces spaces
>>. opt ( >>. opt (
pstring "---" pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---"))
>>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---"))
|>> fun yamlStr -> |>> fun yamlStr ->
let deserializer = DeserializerBuilder().Build() let deserializer = DeserializerBuilder().Build()
let dict = deserializer.Deserialize<Dictionary<string, string>>(yamlStr) let dict = deserializer.Deserialize<Dictionary<string, string>>(yamlStr)
if isNull dict then Map.empty
else dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq if isNull dict then
Map.empty
else
dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq
) )
.>> spaces .>> spaces
.>>. sepEndBy pBlock (many1 pNewline) .>>. sepEndBy pBlock (many1 pNewline)
.>> eof .>> eof
|>> fun (headerOpt, blocks) -> |>> fun (headerOpt, blocks) -> (defaultArg headerOpt Map.empty, blocks)
(defaultArg headerOpt Map.empty, blocks)
let parse i = let parse i =
match run pDocument i with match run pDocument i with
@ -300,31 +409,25 @@ module Parser =
| Failure(e, _, _) -> failwith e | Failure(e, _, _) -> failwith e
// ========================================== [<AbstractClass>]
// 3. Execution & Printer type IEvaluator() =
// ==========================================
type IEvaluator =
abstract member Evaluate: string -> string abstract member Evaluate: string -> string
abstract member NewSession: unit -> unit
module Execution =
open Ast
let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (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
module Evaluators = module Evaluators =
open System.IO open System.IO
open System.Text open System.Text
open FSharp.Compiler.Interactive.Shell open FSharp.Compiler.Interactive.Shell
type NullEvaluator() =
inherit IEvaluator()
override this.Evaluate(code: string) = ""
override this.NewSession() = ()
type FsiEvaluator() = type FsiEvaluator() =
inherit IEvaluator()
let sbOut = StringBuilder() let sbOut = StringBuilder()
let sbErr = StringBuilder() let sbErr = StringBuilder()
let inStream = new StringReader("") let inStream = new StringReader("")
@ -334,10 +437,11 @@ module Evaluators =
// Initiera FSI-sessionen // Initiera FSI-sessionen
let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration() let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
let argv = [| "fsi.exe"; "--noninteractive" |] let argv = [| "fsi.exe"; "--noninteractive" |]
let session = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)
interface IEvaluator with let session =
member _.Evaluate(code: string) = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)
override this.Evaluate(code: string) =
sbOut.Clear() |> ignore sbOut.Clear() |> ignore
sbErr.Clear() |> ignore sbErr.Clear() |> ignore
@ -352,16 +456,22 @@ module Evaluators =
output.Replace("\r\n", "\n").Split('\n') output.Replace("\r\n", "\n").Split('\n')
|> Array.filter (fun line -> |> Array.filter (fun line ->
let l = line.TrimStart() let l = line.TrimStart()
not (l.StartsWith("val ") || l.StartsWith("type ") || l.StartsWith("module ") || l.StartsWith("namespace "))
) not (
l.StartsWith("val ")
|| l.StartsWith("type ")
|| l.StartsWith("module ")
|| l.StartsWith("namespace ")
))
|> String.concat "\n" |> String.concat "\n"
|> fun s -> s.Trim() |> fun s -> s.Trim()
match result with match result with
| Choice1Of2 (Some fsiValue) -> | Choice1Of2(Some fsiValue) ->
// Plocka ut värdet. Om det är en sträng, undvik "%A" för att slippa citattecken. // Plocka ut värdet. Om det är en sträng, undvik "%A" för a tattecken.
let valStr = let valStr =
if isNull fsiValue.ReflectionValue then "" if isNull fsiValue.ReflectionValue then
""
else else
match fsiValue.ReflectionValue with match fsiValue.ReflectionValue with
| :? string as s -> s | :? string as s -> s
@ -378,18 +488,129 @@ module Evaluators =
cleanOutput cleanOutput
| Choice2Of2 ex -> | Choice2Of2 ex ->
let fsiErrorOutput = if System.String.IsNullOrEmpty(errors) then "Ingen ytterligare FSI-output." else errors let fsiErrorOutput =
sprintf """ if System.String.IsNullOrEmpty(errors) then
"Ingen ytterligare FSI-output."
else
errors
sprintf
"""
<div style="color: #721c24; background-color: #f8d7da; border-color: #f5c6cb; padding: 10px; margin-bottom: 10px; border-radius: 5px;"> <div style="color: #721c24; background-color: #f8d7da; border-color: #f5c6cb; padding: 10px; margin-bottom: 10px; border-radius: 5px;">
<strong>FSI Exekveringsfel!</strong><br/> <strong>FSI Exekveringsfel!</strong><br/>
<strong>Kod som kördes:</strong> <code>%s</code><br/><br/> <strong>Kod som kördes:</strong> <code>%s</code><br/><br/>
<strong>Exception:</strong> %s<br/> <strong>Exception:</strong> %s<br/>
<strong>FSI Stderr:</strong> <pre style="margin:0; background: rgba(255,255,255,0.5); padding: 5px;">%s</pre> <strong>FSI Stderr:</strong> <pre style="margin:0; background: rgba(255,255,255,0.5); padding: 5px;">%s</pre>
</div>""" code ex.Message fsiErrorOutput </div>"""
code
ex.Message
fsiErrorOutput
with ex -> with ex ->
sprintf """<div style="color: red; border: 1px solid red; padding: 10px;"> sprintf
"""<div style="color: red; border: 1px solid red; padding: 10px;">
<strong>Kritiskt FSI-systemfel:</strong> %s <strong>Kritiskt FSI-systemfel:</strong> %s
</div>""" ex.Message </div>"""
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<string, string>)
(prelude: Map<string, TagRenderer>)
(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

View file

@ -7,14 +7,16 @@ module Pandoc =
open System.Diagnostics open System.Diagnostics
let toHtml (from: string) (markdownText: string) = let toHtml (from: string) (markdownText: string) =
let startInfo = ProcessStartInfo( let startInfo =
ProcessStartInfo(
FileName = "pandoc", FileName = "pandoc",
Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua", Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua",
RedirectStandardInput = true, RedirectStandardInput = true,
RedirectStandardOutput = true, RedirectStandardOutput = true,
RedirectStandardError = true, RedirectStandardError = true,
UseShellExecute = false, UseShellExecute = false,
CreateNoWindow = true) CreateNoWindow = true
)
try try
use proc = Process.Start startInfo use proc = Process.Start startInfo
@ -30,6 +32,7 @@ module Pandoc =
proc.WaitForExit() proc.WaitForExit()
Console.WriteLine(htmlOutput) Console.WriteLine(htmlOutput)
if proc.ExitCode = 0 then if proc.ExitCode = 0 then
htmlOutput.Trim() htmlOutput.Trim()
else else
@ -40,5 +43,5 @@ module Pandoc =
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText
let mdToHtml markdownText = let mdToHtml markdownText =
let res= toHtml "markdown" markdownText let res = toHtml "markdown" markdownText
res res

View file

@ -1,26 +1,48 @@
namespace Fibble.FibLib namespace Fibble.FibLib
open FSharp.Compiler.Text
open Fibble.FibLib.Ast open Fibble.FibLib.Ast
module Helpers = module Helpers =
let emptyAttr ={id=""; classes=[]; kvp=[]} let emptyAttr = { id = ""; classes = []; kvp = [] }
let ah cls kvp = let ah cls kvp =
{id=""; classes = [cls]; kvp = Map.toList kvp } { id = ""
classes = [ cls ]
kvp = Map.toList kvp }
let onlyChildren constructor : TagRenderer = 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 open Helpers
module ConstructionHelpers = module ConstructionHelpers =
let linebreak _ _ _ _ = LineBreak let linebreak _ _ _ _ = Inline(LineBreak)
let softbreak _ _ _ _ = SoftBreak let softbreak _ _ _ _ = Inline(SoftBreak)
let value : TagRenderer = let value: TagRenderer =
fun meta args _ _ -> fun meta args _ _ ->
match Map.tryFind args.Head meta with match Map.tryFind args.Head meta with
| Some(v) -> Text v | Some v -> Inline(Text v)
| None -> Text $"value {args.Head} not found in metadata" | None -> Inline(Text $"value {args.Head} not found in metadata")
let emph = onlyChildren Emph let emph = onlyChildren Emph
@ -30,24 +52,39 @@ module ConstructionHelpers =
let superscript = onlyChildren Superscript let superscript = onlyChildren Superscript
let subscript = onlyChildren Subscript let subscript = onlyChildren Subscript
let image : TagRenderer = let image: TagRenderer =
fun _ args kwargs children -> fun _ args kwargs children ->
let attributes = ah "inlineImage" kwargs let attributes = ah "inlineImage" kwargs
Image(attributes,children, args[0]) Inline(Image(attributes, children, args[0]))
let code : TagRenderer =
let code: TagRenderer =
fun _ _ kwargs children -> fun _ _ kwargs children ->
let attributes = ah "inlineCode" kwargs let attributes = ah "inlineCode" kwargs
match children with match children with
| [Text(c)] -> InlineNode.Code(attributes, c) | [ Text(c) ] -> Inline(InlineNode.Code(attributes, c))
| _ -> failwith "Code tag was not Text," | _ -> failwith "Code tag was not Text,"
let link : TagRenderer = let link: TagRenderer =
fun _ args kwargs children -> fun _ args kwargs children ->
let attributes = ah "link" kwargs let attributes = ah "link" kwargs
Link(attributes,Target(args[0], children)) Inline(Link(attributes, Target(args[0], children)))
// blocks // blocks
let paragraph _ _ _ children = Paragraph(children) let paragraph _ _ _ children = Paragraph(children)
let plain _ _ _ children = Plain(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))