Compare commits
3 commits
ec2173632c
...
c3f2f98dc8
| Author | SHA1 | Date | |
|---|---|---|---|
| c3f2f98dc8 | |||
| f1fefece72 | |||
| 6e26f37759 |
11 changed files with 875 additions and 404 deletions
6
Fibble.slnx
Normal file
6
Fibble.slnx
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
<Solution>
|
||||||
|
<Folder Name="/src/">
|
||||||
|
<Project Path="src/Bif/Bif.fsproj" />
|
||||||
|
<Project Path="src/FibLib/FibLib.fsproj" />
|
||||||
|
</Folder>
|
||||||
|
</Solution>
|
||||||
|
|
@ -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>
|
||||||
|
|
|
||||||
|
|
@ -1,80 +1,55 @@
|
||||||
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> =
|
||||||
|
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<string, TagRenderer> =
|
"md", fun _ _ _ _ -> Inline(Text "hej") ]
|
||||||
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))
|
|
||||||
]
|
|
||||||
|
|
||||||
// ==========================================
|
|
||||||
// 2. Mall och Evaluator
|
|
||||||
// ==========================================
|
|
||||||
//
|
|
||||||
module File =
|
module File =
|
||||||
let readFile path =
|
let readFile path =
|
||||||
match Path.Exists(path) with
|
match Path.Exists(path) with
|
||||||
| true -> File.ReadAllText(path)
|
| true -> File.ReadAllText(path)
|
||||||
| _ -> failwith $"{Path.GetFullPath path} does not exist"
|
| _ -> failwith $"{Path.GetFullPath path} does not exist"
|
||||||
|
|
||||||
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
53
src/Bif/_page-template
Normal 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>
|
||||||
|
|
@ -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
115
src/FibLib/AstUtils.fs
Normal 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 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)
|
||||||
|
)
|
||||||
|
|
@ -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>
|
||||||
|
|
|
||||||
|
|
@ -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) =
|
// --- HJÄLPARFUNKTIONER ---
|
||||||
args
|
|
||||||
|> List.map (fun k -> sprintf "%s=\"%s\"" (fst k) (snd k))
|
let escapeHtml (text: string) =
|
||||||
|> String.concat " "
|
if System.String.IsNullOrEmpty(text) then
|
||||||
let rec renderInline =
|
""
|
||||||
let renderAll l =
|
else
|
||||||
l
|
WebUtility.HtmlEncode(text)
|
||||||
|> List.map renderInline
|
|
||||||
|> String.concat ""
|
// 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
|
function
|
||||||
| Text t -> WebUtility.HtmlEncode t
|
| Paragraph children -> sprintf "<p>%s</p>\n" (renderInlines children)
|
||||||
| Strong(t) -> sprintf "<strong>%s</strong>" (renderAll t)
|
|
||||||
| RawHtml h ->
|
|
||||||
h
|
|
||||||
| _ -> ""
|
|
||||||
|
|
||||||
let renderFigure a c l =
|
| Plain inlines -> sprintf "%s\n" (renderInlines inlines)
|
||||||
failwith "haha"
|
|
||||||
|
|
||||||
let renderListItem item =
|
| CodeBlock(attr, text) -> sprintf "<pre><code%s>%s</code></pre>\n" (renderAttr attr) (escapeHtml text)
|
||||||
sprintf "<li>%s</li>" item
|
|
||||||
|
|
||||||
let renderList kind attributes nodesList =
|
| Figure(attr, caption, blocks) ->
|
||||||
let content = nodesList
|
let bodyHtml = blocks |> List.map renderBlock |> String.concat ""
|
||||||
|> List.map renderListItem
|
let captionHtml = renderInlines caption
|
||||||
|> String.concat "\n"
|
sprintf "<figure%s>\n%s<figcaption>%s</figcaption>\n</figure>\n" (renderAttr attr) bodyHtml captionHtml
|
||||||
$"<{kind} {(renderAttributes attributes)}>{content}</{kind}>"
|
|
||||||
|
|
||||||
|
| 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
|
||||||
|
|
||||||
let rec render blocks =
|
| ListBlock kind ->
|
||||||
let doubleRender blocksblock =
|
match kind with
|
||||||
List.map render blocksblock
|
| Orderedlist(attr, start, blocksList) ->
|
||||||
|
let startAttr = if start <> 1 then sprintf " start=\"%d\"" start else ""
|
||||||
|
|
||||||
let renderNode = function
|
let itemsHtml =
|
||||||
| Paragraph [RawHtml html] ->
|
blocksList
|
||||||
html
|
|> List.map (fun b -> sprintf "<li>%s</li>\n" (b |> List.map renderBlock |> String.concat ""))
|
||||||
| Paragraph nodes when nodes |> List.forall (function
|
|> String.concat ""
|
||||||
| RawHtml _ -> true
|
|
||||||
| Text t when System.String.IsNullOrWhiteSpace(t) -> true
|
sprintf "<ol%s%s>\n%s</ol>\n" (renderAttr attr) startAttr itemsHtml
|
||||||
| _ -> false) ->
|
|
||||||
nodes
|
| BulletList(attr, blocksList) ->
|
||||||
|> List.choose (function RawHtml h -> Some h | _ -> None)
|
let itemsHtml =
|
||||||
|> String.concat "\n"
|
blocksList
|
||||||
| Paragraph c -> sprintf "<p>%s</p>" (c |> List.map renderInline |> String.concat "")
|
|> List.map (fun b -> sprintf "<li>%s</li>\n" (b |> List.map renderBlock |> String.concat ""))
|
||||||
| Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l
|
|> String.concat ""
|
||||||
| CodeBlock(attributes, text) -> sprintf "<code>%s</code>" text
|
|
||||||
| Figure(attributes, caption, blocks) -> renderFigure attributes caption blocks
|
sprintf "<ul%s>\n%s</ul>\n" (renderAttr attr) itemsHtml
|
||||||
| ListBlock(l) -> match l with
|
| Table(attr, rows) ->
|
||||||
| BulletList(attr, blocknodes) -> renderList "ul" attr.kvp (doubleRender blocknodes)
|
let renderedRows = List.map renderRow rows |> String.concat " "
|
||||||
| Orderedlist(attr, start, blocknodes) -> renderList "ol" attr.kvp (doubleRender blocknodes)
|
sprintf "<table%s>%s</table>" (renderAttr attr) renderedRows
|
||||||
| Plain nodes -> List.map renderInline nodes |> String.concat " "
|
|
||||||
blocks
|
// Renderar en lista av Inline-noder
|
||||||
|> List.map renderNode
|
and renderInlines inlines =
|
||||||
|> String.concat "\n"
|
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 på 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"
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
many1Chars (noneOf "()\"")
|
[ pFSharpString
|
||||||
pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)"
|
many1Chars (noneOf "()\"")
|
||||||
])
|
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 "\"\"\"")
|
|
||||||
|>> fun c -> Expr(c, None)
|
|
||||||
|
|
||||||
// pInlineCommand använder nu forward-referensen pBodyRef
|
|
||||||
let pInlineCommand =
|
let pInlineCommand =
|
||||||
attempt (pchar '@' >>. many1Chars asciiLetter)
|
attempt (pchar '@' >>. many1Chars asciiLetter) .>>. opt pArgs .>>. opt pBody
|
||||||
.>>. 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, kwargs = separateArgs rawArgs
|
||||||
let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList
|
// dedentNodes fixes indentation of inline commands spanning several lines
|
||||||
|
|
||||||
// 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, 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)
|
||||||
|
|
||||||
|
|
||||||
// Nu när pInlineCommand, pExpr och pMultilineCode är definierade
|
|
||||||
// kan vi skapa pInnerInline
|
|
||||||
let pInnerInline =
|
let pInnerInline =
|
||||||
choice [
|
choice
|
||||||
attempt pInlineCommand
|
[ pAtCommand // Hanterar alla @-baserade noder
|
||||||
attempt pExpr
|
many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt
|
||||||
pMultilineCode
|
|
||||||
many1Chars (noneOf "@}") |>> Text
|
|
||||||
pchar '@' |>> fun _ -> Text "@"
|
|
||||||
]
|
|
||||||
|
|
||||||
// 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
|
many1Chars (noneOf "@{}\n\r") |>> Text
|
||||||
pInlineCommand
|
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ]
|
||||||
many1Chars (noneOf "@{}\n\r") |>> Text
|
|
||||||
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,33 +409,27 @@ 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("")
|
||||||
let outStream = new StringWriter(sbOut)
|
let outStream = new StringWriter(sbOut)
|
||||||
let errStream = new StringWriter(sbErr)
|
let errStream = new StringWriter(sbErr)
|
||||||
|
|
@ -334,62 +437,180 @@ 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)
|
||||||
sbOut.Clear() |> ignore
|
|
||||||
sbErr.Clear() |> ignore
|
|
||||||
|
|
||||||
try
|
override this.Evaluate(code: string) =
|
||||||
let result, _warnings = session.EvalInteractionNonThrowing(code)
|
sbOut.Clear() |> ignore
|
||||||
|
sbErr.Clear() |> ignore
|
||||||
|
|
||||||
let output = sbOut.ToString()
|
try
|
||||||
let errors = sbErr.ToString().Trim()
|
let result, _warnings = session.EvalInteractionNonThrowing(code)
|
||||||
|
|
||||||
// Filtrera bort FSI:s automatiska typsignaturer från utskriften
|
let output = sbOut.ToString()
|
||||||
let cleanOutput =
|
let errors = sbErr.ToString().Trim()
|
||||||
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
|
// Filtrera bort FSI:s automatiska typsignaturer från utskriften
|
||||||
| Choice1Of2 (Some fsiValue) ->
|
let cleanOutput =
|
||||||
// Plocka ut värdet. Om det är en sträng, undvik "%A" för att slippa citattecken.
|
output.Replace("\r\n", "\n").Split('\n')
|
||||||
let valStr =
|
|> Array.filter (fun line ->
|
||||||
if isNull fsiValue.ReflectionValue then ""
|
let l = line.TrimStart()
|
||||||
else
|
|
||||||
match fsiValue.ReflectionValue with
|
|
||||||
| :? string as s -> s
|
|
||||||
| v -> sprintf "%A" v
|
|
||||||
|
|
||||||
if System.String.IsNullOrEmpty(cleanOutput) then valStr
|
not (
|
||||||
elif System.String.IsNullOrEmpty(valStr) then cleanOutput
|
l.StartsWith("val ")
|
||||||
else cleanOutput + "\n" + valStr
|
|| l.StartsWith("type ")
|
||||||
|
|| l.StartsWith("module ")
|
||||||
|
|| l.StartsWith("namespace ")
|
||||||
|
))
|
||||||
|
|> String.concat "\n"
|
||||||
|
|> fun s -> s.Trim()
|
||||||
|
|
||||||
| Choice1Of2 None ->
|
match result with
|
||||||
if not (System.String.IsNullOrEmpty(errors)) then
|
| Choice1Of2(Some fsiValue) ->
|
||||||
cleanOutput + sprintf "%A" errors
|
// Plocka ut värdet. Om det är en sträng, undvik "%A" för a tattecken.
|
||||||
|
let valStr =
|
||||||
|
if isNull fsiValue.ReflectionValue then
|
||||||
|
""
|
||||||
else
|
else
|
||||||
cleanOutput
|
match fsiValue.ReflectionValue with
|
||||||
|
| :? string as s -> s
|
||||||
|
| v -> sprintf "%A" v
|
||||||
|
|
||||||
| Choice2Of2 ex ->
|
if System.String.IsNullOrEmpty(cleanOutput) then valStr
|
||||||
let fsiErrorOutput = if System.String.IsNullOrEmpty(errors) then "Ingen ytterligare FSI-output." else errors
|
elif System.String.IsNullOrEmpty(valStr) then cleanOutput
|
||||||
sprintf """
|
else cleanOutput + "\n" + valStr
|
||||||
<div style="color: #721c24; background-color: #f8d7da; border-color: #f5c6cb; padding: 10px; margin-bottom: 10px; border-radius: 5px;">
|
|
||||||
<strong>FSI Exekveringsfel!</strong><br/>
|
|
||||||
<strong>Kod som kördes:</strong> <code>%s</code><br/><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>
|
|
||||||
</div>""" code ex.Message fsiErrorOutput
|
|
||||||
|
|
||||||
with ex ->
|
| Choice1Of2 None ->
|
||||||
sprintf """<div style="color: red; border: 1px solid red; padding: 10px;">
|
if not (System.String.IsNullOrEmpty(errors)) then
|
||||||
<strong>Kritiskt FSI-systemfel:</strong> %s
|
cleanOutput + sprintf "%A" errors
|
||||||
</div>""" ex.Message
|
else
|
||||||
|
cleanOutput
|
||||||
|
|
||||||
|
| Choice2Of2 ex ->
|
||||||
|
let fsiErrorOutput =
|
||||||
|
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;">
|
||||||
|
<strong>FSI Exekveringsfel!</strong><br/>
|
||||||
|
<strong>Kod som kördes:</strong> <code>%s</code><br/><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>
|
||||||
|
</div>"""
|
||||||
|
code
|
||||||
|
ex.Message
|
||||||
|
fsiErrorOutput
|
||||||
|
|
||||||
|
with ex ->
|
||||||
|
sprintf
|
||||||
|
"""<div style="color: red; border: 1px solid red; padding: 10px;">
|
||||||
|
<strong>Kritiskt FSI-systemfel:</strong> %s
|
||||||
|
</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
|
||||||
|
|
|
||||||
|
|
@ -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 =
|
||||||
FileName = "pandoc",
|
ProcessStartInfo(
|
||||||
Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua",
|
FileName = "pandoc",
|
||||||
RedirectStandardInput = true,
|
Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua",
|
||||||
RedirectStandardOutput = true,
|
RedirectStandardInput = true,
|
||||||
RedirectStandardError = true,
|
RedirectStandardOutput = true,
|
||||||
UseShellExecute = false,
|
RedirectStandardError = true,
|
||||||
CreateNoWindow = true)
|
UseShellExecute = false,
|
||||||
|
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
|
||||||
|
|
|
||||||
|
|
@ -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 =
|
|
||||||
{id=""; classes = [cls]; kvp = Map.toList kvp }
|
let ah cls 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
|
|
||||||
| [Text(c)] -> InlineNode.Code(attributes, c)
|
|
||||||
| _ -> failwith "Code tag was not Text,"
|
|
||||||
|
|
||||||
let link : TagRenderer =
|
match children with
|
||||||
|
| [ Text(c) ] -> Inline(InlineNode.Code(attributes, c))
|
||||||
|
| _ -> failwith "Code tag was not Text,"
|
||||||
|
|
||||||
|
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))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue