Compare commits
No commits in common. "c3f2f98dc815b52a1d54cf04359d69aef61ccc15" and "ec2173632c58bbbf01ad0e5c8c8b1d97b33062ad" have entirely different histories.
c3f2f98dc8
...
ec2173632c
11 changed files with 403 additions and 874 deletions
|
|
@ -1,6 +0,0 @@
|
|||
<Solution>
|
||||
<Folder Name="/src/">
|
||||
<Project Path="src/Bif/Bif.fsproj" />
|
||||
<Project Path="src/FibLib/FibLib.fsproj" />
|
||||
</Folder>
|
||||
</Solution>
|
||||
|
|
@ -7,9 +7,6 @@
|
|||
|
||||
<ItemGroup>
|
||||
<Compile Include="Program.fs" />
|
||||
<Content Include="document.fib" />
|
||||
<Content Include="strip-p.lua" />
|
||||
<Content Include="_page-template" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
|
|
|||
|
|
@ -1,31 +1,46 @@
|
|||
open System.IO
|
||||
open System.Net
|
||||
open System.IO
|
||||
open System.Runtime.CompilerServices
|
||||
open FSharp.Compiler.Text
|
||||
open Fibble.FibLib
|
||||
open Fibble.FibLib.Ast
|
||||
open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc.
|
||||
open Fibble.FibLib.Pandoc
|
||||
open Fibble.FibLib.HtmlPrinter
|
||||
open Fibble.FibLib.Utils
|
||||
open Fibble.FibLib.ConstructionHelpers
|
||||
|
||||
// ==========================================
|
||||
// 1. Prelude (Dina egna taggar)
|
||||
// ==========================================
|
||||
|
||||
let myPrelude: Map<string, TagRenderer> =
|
||||
Map
|
||||
[ "quotient",
|
||||
fun _ args _ _ ->
|
||||
|
||||
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))
|
||||
| [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)
|
||||
Inline(RawHtml "hej")
|
||||
"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", table
|
||||
|
||||
"md", fun _ _ _ _ -> Inline(Text "hej") ]
|
||||
"table", fun _ _ _ children -> Text "hej"
|
||||
"md", fun _ _ _ children -> RawHtml (mdToHtml (stringifyNodes children))
|
||||
]
|
||||
|
||||
// ==========================================
|
||||
// 2. Mall och Evaluator
|
||||
// ==========================================
|
||||
//
|
||||
module File =
|
||||
let readFile path =
|
||||
match Path.Exists(path) with
|
||||
|
|
@ -35,21 +50,31 @@ module File =
|
|||
let pageTemplate = File.readFile "_page-template"
|
||||
|
||||
let sourceCode = File.readFile "document.fib"
|
||||
|
||||
|
||||
// ==========================================
|
||||
// 3. Huvudpipeline
|
||||
// ==========================================
|
||||
let processDocument (source: string) =
|
||||
let evaluator = Evaluators.NullEvaluator()
|
||||
let evaluator = Evaluators.FsiEvaluator()
|
||||
|
||||
// Parsa koden
|
||||
let metadata, raewBlocks = Parser.parse source
|
||||
let rawBlocks = AstUtils.slurpSections raewBlocks
|
||||
// Steg 1: Parsa koden
|
||||
let metadata, rawBlocks = Parser.parse source
|
||||
|
||||
|
||||
// Steg 2: Transformera och exekvera trädet
|
||||
let evaluatedBlocks =
|
||||
CommandEvaluator.evaluateDocument metadata myPrelude evaluator rawBlocks
|
||||
rawBlocks |> List.map (function
|
||||
| Paragraph children ->
|
||||
Paragraph (children
|
||||
|> List.map (Execution.transform metadata myPrelude evaluator))
|
||||
| Section(l, a, children) ->
|
||||
Section(l, a, children
|
||||
|> List.map (Execution.transform metadata myPrelude evaluator))
|
||||
| _ -> failwith "haha"
|
||||
|
||||
// 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
|
||||
let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml)
|
||||
|
|
|
|||
|
|
@ -1,53 +0,0 @@
|
|||
<!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,10 +6,44 @@ title: FSI Test
|
|||
|
||||
@section{Definitioner}
|
||||
Vi definierar en funktion och en variabel.
|
||||
@"""
|
||||
let globalCounter = ref 0
|
||||
|
||||
@table{
|
||||
rubrik 1 | rubrik 2
|
||||
1 | 3
|
||||
2 | 4
|
||||
let increment () =
|
||||
globalCounter.Value <- globalCounter.Value + 1
|
||||
sprintf "Räknaren är nu %d" globalCounter.Value
|
||||
"""
|
||||
@(1)
|
||||
|
||||
@link[www.google.com]{hejsan hoppsan fallerallera}
|
||||
|
||||
Detta är en paragraf som har lite text i sig och lite @md{inbäddad *markdown* som kanske} funkar. Det är bra så.
|
||||
|
||||
@md{
|
||||
babeuoastnuhaoesn
|
||||
|
||||
hej hopp
|
||||
--- ----
|
||||
abc defg
|
||||
bde dddd
|
||||
ueo eoau
|
||||
ueo aoeu
|
||||
}
|
||||
|
||||
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]
|
||||
|
|
|
|||
|
|
@ -1,115 +0,0 @@
|
|||
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,7 +8,6 @@
|
|||
<ItemGroup>
|
||||
<Compile Include="Pandoc.fs" />
|
||||
<Compile Include="Library.fs" />
|
||||
<Compile Include="AstUtils.fs" />
|
||||
<Compile Include="constructorHelpers.fs" />
|
||||
<Compile Include="HtmlPrinter.fs" />
|
||||
</ItemGroup>
|
||||
|
|
|
|||
|
|
@ -4,151 +4,60 @@ module Fibble.FibLib.HtmlPrinter
|
|||
|
||||
open System.Net
|
||||
|
||||
module HtmlWriter =
|
||||
module HtmlPrinter =
|
||||
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
|
||||
| _ -> ""
|
||||
|
||||
// --- HJÄLPARFUNKTIONER ---
|
||||
let renderFigure a c l =
|
||||
failwith "haha"
|
||||
|
||||
let escapeHtml (text: string) =
|
||||
if System.String.IsNullOrEmpty(text) then
|
||||
""
|
||||
else
|
||||
WebUtility.HtmlEncode(text)
|
||||
let renderListItem item =
|
||||
sprintf "<li>%s</li>" item
|
||||
|
||||
// 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) =
|
||||
let renderList kind attributes nodesList =
|
||||
let content = nodesList
|
||||
|> 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
|
||||
|> List.map (function
|
||||
| Text t -> t
|
||||
| RawHtml h -> h
|
||||
| Emph c
|
||||
| Underline c
|
||||
| Strong c
|
||||
| Strikeout c
|
||||
| Superscript c
|
||||
| Subscript c -> extractText c
|
||||
| Link(_, (_, c)) -> extractText c
|
||||
| Code(_, t) -> t
|
||||
| _ -> "")
|
||||
|> String.concat ""
|
||||
|
||||
// Bygger attributsträngen: id="X" class="Y Z" key="value"
|
||||
let renderAttr (attr: Attr) =
|
||||
let idStr =
|
||||
if System.String.IsNullOrWhiteSpace(attr.id) then
|
||||
""
|
||||
else
|
||||
sprintf " id=\"%s\"" attr.id
|
||||
|
||||
let classStr =
|
||||
match attr.classes with
|
||||
| [] -> ""
|
||||
| classes -> sprintf " class=\"%s\"" (String.concat " " classes)
|
||||
|
||||
let kvpStr =
|
||||
match attr.kvp with
|
||||
| [] -> ""
|
||||
| kvps ->
|
||||
let pairs = kvps |> List.map (fun (k, v) -> sprintf "%s=\"%s\"" k v)
|
||||
" " + (String.concat " " pairs)
|
||||
|
||||
idStr + classStr + kvpStr
|
||||
|
||||
|
||||
|
||||
// --- HUVUDRENDERARE ---
|
||||
|
||||
let rec renderDocument (blocks: BlockNode list) =
|
||||
blocks |> List.map renderBlock |> String.concat ""
|
||||
|
||||
// Renderar Block-noder
|
||||
and renderBlock =
|
||||
function
|
||||
| Paragraph children -> sprintf "<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 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"
|
||||
|> List.choose (function RawHtml h -> Some h | _ -> None)
|
||||
|> String.concat "\n"
|
||||
| Paragraph c -> sprintf "<p>%s</p>" (c |> List.map renderInline |> String.concat "")
|
||||
| Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l
|
||||
| CodeBlock(attributes, text) -> sprintf "<code>%s</code>" text
|
||||
| Figure(attributes, caption, blocks) -> renderFigure attributes caption blocks
|
||||
| ListBlock(l) -> match l with
|
||||
| BulletList(attr, blocknodes) -> renderList "ul" attr.kvp (doubleRender blocknodes)
|
||||
| Orderedlist(attr, start, blocknodes) -> renderList "ol" attr.kvp (doubleRender blocknodes)
|
||||
| Plain nodes -> List.map renderInline nodes |> String.concat " "
|
||||
blocks
|
||||
|> List.map renderNode
|
||||
|> String.concat "\n"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
namespace Fibble.FibLib
|
||||
|
||||
|
||||
open System
|
||||
open System.Net
|
||||
open FParsec
|
||||
open YamlDotNet.Serialization
|
||||
open System.Collections.Generic
|
||||
|
|
@ -12,10 +11,7 @@ open System.Collections.Generic
|
|||
// ==========================================
|
||||
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 =
|
||||
|
|
@ -35,82 +31,62 @@ module Ast =
|
|||
| LineBreak
|
||||
| Expr of code: string * result: string option
|
||||
| Command of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list
|
||||
|
||||
and BlockNode =
|
||||
| BlockCommand of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list
|
||||
| CodeBlock of attributes: Attr * text: string
|
||||
| Figure of attributes: Attr * caption: InlineNode list * blocks: BlockNode list
|
||||
| ListBlock of ListKind
|
||||
| Plain of InlineNode list
|
||||
| Paragraph of 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
|
||||
|
||||
| Section of level: int * args: (string * string) list * children: InlineNode list
|
||||
and ListKind =
|
||||
| Orderedlist of attributes: Attr * start: int * blocksList: (BlockNode list) list
|
||||
| BulletList of attributes: Attr * blocksList: (BlockNode list) list
|
||||
|
||||
and Url = string
|
||||
and Target = Url * InlineNode list
|
||||
|
||||
type Document = BlockNode list
|
||||
|
||||
type TocEntry =
|
||||
| TocGroup of title: string * id: string * children: TocEntry list
|
||||
| TocEntity of title: string * id: string
|
||||
|
||||
type NextDocument =
|
||||
{ document: BlockNode list
|
||||
Toc: TocEntry list
|
||||
Footnotes: BlockNode list list
|
||||
Metadata: Map<string, string> }
|
||||
|
||||
type NodeResult =
|
||||
| Inline of InlineNode
|
||||
| Block of BlockNode
|
||||
|
||||
type TagRenderer = Map<string, string> -> string list -> Map<string, string> -> InlineNode list -> NodeResult
|
||||
|
||||
type TagRenderer = Map<string,string>
|
||||
-> string list
|
||||
-> Map<string,string>
|
||||
-> InlineNode list -> InlineNode
|
||||
|
||||
let rec stringifyNodes (nodes: InlineNode list) =
|
||||
nodes
|
||||
|> List.map (function
|
||||
| Text t -> t
|
||||
| RawHtml h -> h
|
||||
| Expr(_, Some res) -> res
|
||||
| Expr(code, None) -> sprintf "@(%s)" code // Fallback om den inte evaluerats
|
||||
| _ -> failwith "haha"
|
||||
)
|
||||
|> String.concat ""
|
||||
|
||||
|
||||
|
||||
module Utils =
|
||||
open Ast
|
||||
|
||||
let dedentNodes (nodes: InlineNode list) =
|
||||
let fullText =
|
||||
nodes
|
||||
|> List.choose (function
|
||||
| Text t -> Some t
|
||||
| _ -> None)
|
||||
|> String.concat ""
|
||||
nodes |> List.choose (function Text t -> Some t | _ -> None) |> String.concat ""
|
||||
|
||||
let lines = fullText.Replace("\r\n", "\n").Split('\n')
|
||||
|
||||
// 1. Räkna BARA ut minIndent från rader som kommer efter en radbrytning (skippa rad 0)
|
||||
let minIndent =
|
||||
if lines.Length <= 1 then
|
||||
0
|
||||
if lines.Length <= 1 then 0
|
||||
else
|
||||
lines
|
||||
|> Array.skip 1
|
||||
lines |> Array.skip 1
|
||||
|> Array.filter (fun l -> not (System.String.IsNullOrWhiteSpace(l)))
|
||||
|> Array.map (fun l -> l.Length - l.TrimStart().Length)
|
||||
|> function
|
||||
| [||] -> 0
|
||||
| arr -> Array.min arr
|
||||
|> function [||] -> 0 | arr -> Array.min arr
|
||||
|
||||
let mutable isFirstText = true
|
||||
let indentStr = "\n" + String.replicate minIndent " "
|
||||
|
||||
// 2. Applicera formateringen
|
||||
let dedented =
|
||||
nodes
|
||||
|> List.map (function
|
||||
nodes |> List.map (function
|
||||
| Text t ->
|
||||
let t1 = t.Replace("\r\n", "\n")
|
||||
|
||||
|
|
@ -119,28 +95,22 @@ module Utils =
|
|||
if isFirstText then
|
||||
isFirstText <- false
|
||||
t1.TrimStart(' ', '\t')
|
||||
else
|
||||
t1
|
||||
else t1
|
||||
|
||||
// Ta bort minIndent antal mellanslag efter varje radbrytning i noden
|
||||
let t3 = if minIndent > 0 then t2.Replace(indentStr, "\n") else t2
|
||||
Text t3
|
||||
| otherNode -> otherNode)
|
||||
| otherNode -> otherNode
|
||||
)
|
||||
|
||||
// 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna
|
||||
let rec trimStart =
|
||||
function
|
||||
let rec trimStart = function
|
||||
| Text t :: rest ->
|
||||
let trimmed = t.TrimStart('\n', '\r', ' ', '\t')
|
||||
|
||||
if trimmed = "" then
|
||||
trimStart rest
|
||||
else
|
||||
Text trimmed :: rest
|
||||
if trimmed = "" then trimStart rest else Text trimmed :: rest
|
||||
| other -> other
|
||||
|
||||
let rec trimEnd =
|
||||
function
|
||||
let rec trimEnd = function
|
||||
| Text t :: rest ->
|
||||
let trimmed = t.TrimEnd('\n', '\r', ' ', '\t')
|
||||
if trimmed = "" then trimEnd rest else Text trimmed :: rest
|
||||
|
|
@ -148,36 +118,27 @@ module Utils =
|
|||
|
||||
dedented |> trimStart |> List.rev |> trimEnd |> List.rev
|
||||
|
||||
let positional f : TagRenderer =
|
||||
let positional f: TagRenderer =
|
||||
fun _ (args: string list) _ children -> f args children
|
||||
|
||||
let onlyArgs f =
|
||||
fun _ args kwargs children -> f args kwargs
|
||||
|
||||
let getArgIdx (args: (string * string) list) index defaultVal =
|
||||
let getArgIdx (args: (string*string) list) index defaultVal =
|
||||
let unnamed = args |> List.filter (fun (k, _) -> k = "")
|
||||
|
||||
if index < unnamed.Length then
|
||||
(snd unnamed.[index]).Trim('"')
|
||||
else
|
||||
defaultVal
|
||||
if index < unnamed.Length then (snd unnamed.[index]).Trim('"')
|
||||
else defaultVal
|
||||
|
||||
// This gets the arg defined by "key" unless it is not set, it then tries to get it by index. If that fails, it gets the defaultVal
|
||||
let getArg (args: (string * string) list) (key: string) (index: int) (defaultVal: string) =
|
||||
match args |> List.tryFind (fun (k, _) -> k = key) with
|
||||
| Some(_, v) -> v.Trim('"')
|
||||
| Some (_, v) -> v.Trim('"')
|
||||
| None -> getArgIdx args index defaultVal
|
||||
|
||||
let withArg1 def (f: string -> InlineNode list -> InlineNode) =
|
||||
fun _ args children -> f (getArgIdx args 0 def) children
|
||||
|
||||
let withArg2
|
||||
(k1: string)
|
||||
(d1: string)
|
||||
(k2: string)
|
||||
(d2: string)
|
||||
(f: string -> string -> InlineNode list -> InlineNode)
|
||||
=
|
||||
let withArg2 (k1: string) (d1: string) (k2: string) (d2: string) (f: string -> string -> InlineNode list -> InlineNode) =
|
||||
fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children
|
||||
|
||||
|
||||
|
|
@ -189,30 +150,14 @@ module Utils =
|
|||
|
||||
module Parser =
|
||||
open Ast
|
||||
let pseudoRandom = new System.Random()
|
||||
|
||||
let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit> ()
|
||||
let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit>()
|
||||
|
||||
let getSectionLevel (name: string) =
|
||||
if name = "section" then
|
||||
1
|
||||
elif name = "subsection" then
|
||||
2
|
||||
elif name.StartsWith("sub") && name.EndsWith("section") then
|
||||
(name.Length - 7) / 3 + 1
|
||||
else
|
||||
1
|
||||
|
||||
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
|
||||
if name = "section" then 1
|
||||
elif name = "subsection" then 2
|
||||
elif name.StartsWith("sub") && name.EndsWith("section") then (name.Length - 7) / 3 + 1
|
||||
else 1
|
||||
|
||||
let isSection (name: string) = name.EndsWith("section")
|
||||
|
||||
|
|
@ -220,18 +165,14 @@ module Parser =
|
|||
|
||||
let pNamedArg =
|
||||
// Leta efter "nyckel=värde"
|
||||
attempt (
|
||||
many1Chars (asciiLetter <|> digit <|> anyOf "-_")
|
||||
.>> spaces
|
||||
.>> pchar '='
|
||||
.>> spaces
|
||||
)
|
||||
attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_")
|
||||
.>> spaces .>> pchar '=' .>> spaces)
|
||||
.>>. manyChars (noneOf ",]")
|
||||
|>> fun (k, v) -> k, v.Trim()
|
||||
|>> fun (k, v) -> (k, v.Trim())
|
||||
|
||||
let pPositionalArg =
|
||||
// Bara "värde"
|
||||
manyChars (noneOf ",]") |>> fun v -> "", v.Trim()
|
||||
manyChars (noneOf ",]") |>> fun v -> ("", v.Trim())
|
||||
|
||||
let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces
|
||||
|
||||
|
|
@ -239,169 +180,119 @@ module Parser =
|
|||
between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ','))
|
||||
>>= fun args ->
|
||||
// Validera att positionella argument alltid kommer först
|
||||
let rec validate canBePositional =
|
||||
function
|
||||
let rec validate canBePositional = function
|
||||
| [] -> preturn args // Allt är okej, returnera listan
|
||||
| ("", _) :: tail ->
|
||||
if not canBePositional then
|
||||
fail "Syntaxfel: Positionella argument får inte komma efter namngivna argument."
|
||||
else
|
||||
validate true tail
|
||||
| _ :: tail -> validate false tail
|
||||
else validate true tail
|
||||
| _ :: tail ->
|
||||
validate false tail
|
||||
|
||||
validate true args
|
||||
|
||||
|
||||
let pBody, pBodyRef = createParserForwardedToRef<InlineNode list, unit> ()
|
||||
// --- 1. Måsvinge-parser (för @kommandon) ---
|
||||
// Lägg till en referens för pBody högst upp bland dina referenser
|
||||
// (Bör ligga precis under let pInline, pInlineRef = ...)
|
||||
let pBody, pBodyRef = createParserForwardedToRef<InlineNode list, unit>()
|
||||
|
||||
// --- 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 normal = many1Chars (noneOf "\"\\")
|
||||
let escaped = pstring "\\" >>. anyChar |>> sprintf "\\%c"
|
||||
|
||||
pstring "\"" .>>. manyStrings (normal <|> escaped) .>>. pstring "\""
|
||||
|>> fun ((start, inner), end_) -> start + inner + end_
|
||||
|
||||
pParenBodyRef.Value <-
|
||||
manyStrings (
|
||||
choice
|
||||
[ pFSharpString
|
||||
manyStrings (choice [
|
||||
pFSharpString
|
||||
many1Chars (noneOf "()\"")
|
||||
pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" ]
|
||||
)
|
||||
pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)"
|
||||
])
|
||||
|
||||
let pExpr =
|
||||
attempt (pstring "@(") >>. pParenBody .>> pstring ")" |>> fun c -> Expr(c, None)
|
||||
|
||||
// --- Övriga inline-parsers ---
|
||||
|
||||
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 "\"\"\"")
|
||||
attempt (pstring "@(") >>. pParenBody .>> pstring ")"
|
||||
|>> fun c -> Expr(c, None)
|
||||
|
||||
// Matchar (
|
||||
pchar '(' >>. pParenBody .>> pchar ')' |>> fun c -> Expr(c, None)
|
||||
// --- Övriga inline-parsers ---
|
||||
let pMultilineCode =
|
||||
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"")
|
||||
|>> fun c -> Expr(c, None)
|
||||
|
||||
// Matchar ASCII-bokstäver (för kommandon)
|
||||
many1Chars asciiLetter .>>. opt pArgs .>>. opt pBody
|
||||
// pInlineCommand använder nu forward-referensen pBodyRef
|
||||
let pInlineCommand =
|
||||
attempt (pchar '@' >>. many1Chars asciiLetter)
|
||||
.>>. opt pArgs
|
||||
.>>. opt pBody
|
||||
|>> fun ((name, argsOpt), bodyOpt) ->
|
||||
let rawArgs = defaultArg argsOpt []
|
||||
let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None)
|
||||
let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList
|
||||
|
||||
// dedentNodes anropas här från Utils
|
||||
let 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 =
|
||||
choice
|
||||
[ pAtCommand // Hanterar alla @-baserade noder
|
||||
many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt
|
||||
choice [
|
||||
attempt pInlineCommand
|
||||
attempt pExpr
|
||||
pMultilineCode
|
||||
many1Chars (noneOf "@}") |>> Text
|
||||
pchar '@' |>> fun _ -> Text "@"
|
||||
]
|
||||
|
||||
// Tilldela värdet till pBodyRef
|
||||
pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline)
|
||||
|
||||
pInlineRef.Value <-
|
||||
choice
|
||||
[ pAtCommand
|
||||
// Tilldela värdet till pInlineRef
|
||||
pInlineRef.Value <- choice [
|
||||
pMultilineCode
|
||||
pExpr
|
||||
pInlineCommand
|
||||
many1Chars (noneOf "@{}\n\r") |>> Text
|
||||
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ]
|
||||
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n"
|
||||
pchar '@' |>> fun _ -> Text "@"
|
||||
]
|
||||
|
||||
// --- Block Parsers ---
|
||||
let pSectionBlock =
|
||||
|
||||
let generateId title maybeid =
|
||||
let extractIdFromTitle =
|
||||
function
|
||||
| Text(t) :: rest -> t.Substring(0, (min 20 t.Length)) + pseudoRandom.GetHexString(8)
|
||||
| _ -> pseudoRandom.GetHexString(8)
|
||||
|
||||
match maybeid with
|
||||
| Some v -> v
|
||||
| None -> extractIdFromTitle title
|
||||
|
||||
let tryGetId args kwargs =
|
||||
match args with
|
||||
| [ id ] -> Some(id)
|
||||
| _ -> alistGet kwargs "id"
|
||||
|
||||
attempt (
|
||||
pchar '@' >>. many1Chars asciiLetter
|
||||
>>= fun name ->
|
||||
if isSection name then
|
||||
preturn name
|
||||
else
|
||||
fail "Inte en sektion."
|
||||
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
|
||||
if isSection name then preturn name
|
||||
else fail "Inte en sektion."
|
||||
)
|
||||
.>>. opt pArgs
|
||||
.>>. opt pBody
|
||||
|>> fun ((name, argsOpt), 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, [])
|
||||
Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt [])
|
||||
|
||||
let pParagraphBlock = many1 pInline |>> Paragraph
|
||||
|
||||
let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ]
|
||||
let pBlock = choice [ pSectionBlock; pParagraphBlock ]
|
||||
|
||||
// --- Dokument Parser ---
|
||||
let pDocument =
|
||||
spaces
|
||||
>>. opt (
|
||||
pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---"))
|
||||
pstring "---"
|
||||
>>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---"))
|
||||
|>> fun yamlStr ->
|
||||
let deserializer = DeserializerBuilder().Build()
|
||||
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
|
||||
.>>. sepEndBy pBlock (many1 pNewline)
|
||||
.>> eof
|
||||
|>> fun (headerOpt, blocks) -> (defaultArg headerOpt Map.empty, blocks)
|
||||
|>> fun (headerOpt, blocks) ->
|
||||
(defaultArg headerOpt Map.empty, blocks)
|
||||
|
||||
let parse i =
|
||||
match run pDocument i with
|
||||
|
|
@ -409,25 +300,31 @@ module Parser =
|
|||
| Failure(e, _, _) -> failwith e
|
||||
|
||||
|
||||
[<AbstractClass>]
|
||||
type IEvaluator() =
|
||||
// ==========================================
|
||||
// 3. Execution & Printer
|
||||
// ==========================================
|
||||
type IEvaluator =
|
||||
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 =
|
||||
open System.IO
|
||||
open System.Text
|
||||
open FSharp.Compiler.Interactive.Shell
|
||||
|
||||
type NullEvaluator() =
|
||||
inherit IEvaluator()
|
||||
override this.Evaluate(code: string) = ""
|
||||
override this.NewSession() = ()
|
||||
|
||||
|
||||
|
||||
type FsiEvaluator() =
|
||||
inherit IEvaluator()
|
||||
let sbOut = StringBuilder()
|
||||
let sbErr = StringBuilder()
|
||||
let inStream = new StringReader("")
|
||||
|
|
@ -437,11 +334,10 @@ module Evaluators =
|
|||
// Initiera FSI-sessionen
|
||||
let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
|
||||
let argv = [| "fsi.exe"; "--noninteractive" |]
|
||||
let session = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)
|
||||
|
||||
let session =
|
||||
FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)
|
||||
|
||||
override this.Evaluate(code: string) =
|
||||
interface IEvaluator with
|
||||
member _.Evaluate(code: string) =
|
||||
sbOut.Clear() |> ignore
|
||||
sbErr.Clear() |> ignore
|
||||
|
||||
|
|
@ -456,22 +352,16 @@ module Evaluators =
|
|||
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 ")
|
||||
))
|
||||
not (l.StartsWith("val ") || l.StartsWith("type ") || l.StartsWith("module ") || l.StartsWith("namespace "))
|
||||
)
|
||||
|> String.concat "\n"
|
||||
|> fun s -> s.Trim()
|
||||
|
||||
match result with
|
||||
| Choice1Of2(Some fsiValue) ->
|
||||
// Plocka ut värdet. Om det är en sträng, undvik "%A" för a tattecken.
|
||||
| Choice1Of2 (Some fsiValue) ->
|
||||
// Plocka ut värdet. Om det är en sträng, undvik "%A" för att slippa citattecken.
|
||||
let valStr =
|
||||
if isNull fsiValue.ReflectionValue then
|
||||
""
|
||||
if isNull fsiValue.ReflectionValue then ""
|
||||
else
|
||||
match fsiValue.ReflectionValue with
|
||||
| :? string as s -> s
|
||||
|
|
@ -488,129 +378,18 @@ module Evaluators =
|
|||
cleanOutput
|
||||
|
||||
| Choice2Of2 ex ->
|
||||
let fsiErrorOutput =
|
||||
if System.String.IsNullOrEmpty(errors) then
|
||||
"Ingen ytterligare FSI-output."
|
||||
else
|
||||
errors
|
||||
|
||||
sprintf
|
||||
"""
|
||||
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
|
||||
</div>""" code ex.Message fsiErrorOutput
|
||||
|
||||
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
|
||||
</div>"""
|
||||
ex.Message
|
||||
|
||||
override this.NewSession() =
|
||||
this.Evaluate($"module {Random.Shared.GetHexString(10)}")
|
||||
()
|
||||
</div>""" ex.Message
|
||||
|
||||
|
||||
|
||||
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,16 +7,14 @@ module Pandoc =
|
|||
open System.Diagnostics
|
||||
|
||||
let toHtml (from: string) (markdownText: string) =
|
||||
let startInfo =
|
||||
ProcessStartInfo(
|
||||
let startInfo = ProcessStartInfo(
|
||||
FileName = "pandoc",
|
||||
Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua",
|
||||
RedirectStandardInput = true,
|
||||
RedirectStandardOutput = true,
|
||||
RedirectStandardError = true,
|
||||
UseShellExecute = false,
|
||||
CreateNoWindow = true
|
||||
)
|
||||
CreateNoWindow = true)
|
||||
|
||||
try
|
||||
use proc = Process.Start startInfo
|
||||
|
|
@ -32,7 +30,6 @@ module Pandoc =
|
|||
|
||||
proc.WaitForExit()
|
||||
Console.WriteLine(htmlOutput)
|
||||
|
||||
if proc.ExitCode = 0 then
|
||||
htmlOutput.Trim()
|
||||
else
|
||||
|
|
@ -43,5 +40,5 @@ module Pandoc =
|
|||
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText
|
||||
|
||||
let mdToHtml markdownText =
|
||||
let res = toHtml "markdown" markdownText
|
||||
let res= toHtml "markdown" markdownText
|
||||
res
|
||||
|
|
|
|||
|
|
@ -1,48 +1,26 @@
|
|||
namespace Fibble.FibLib
|
||||
|
||||
open FSharp.Compiler.Text
|
||||
open Fibble.FibLib.Ast
|
||||
|
||||
module Helpers =
|
||||
let emptyAttr = { id = ""; classes = []; kvp = [] }
|
||||
|
||||
let emptyAttr ={id=""; classes=[]; kvp=[]}
|
||||
let ah cls kvp =
|
||||
{ id = ""
|
||||
classes = [ cls ]
|
||||
kvp = Map.toList kvp }
|
||||
|
||||
{id=""; classes = [cls]; kvp = Map.toList kvp }
|
||||
let onlyChildren constructor : TagRenderer =
|
||||
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 }
|
||||
|
||||
|
||||
|
||||
fun _ _ _ children -> constructor(children)
|
||||
|
||||
open Helpers
|
||||
|
||||
module ConstructionHelpers =
|
||||
let linebreak _ _ _ _ = Inline(LineBreak)
|
||||
let softbreak _ _ _ _ = Inline(SoftBreak)
|
||||
let linebreak _ _ _ _ = LineBreak
|
||||
let softbreak _ _ _ _ = SoftBreak
|
||||
|
||||
let value: TagRenderer =
|
||||
let value : TagRenderer =
|
||||
fun meta args _ _ ->
|
||||
match Map.tryFind args.Head meta with
|
||||
| Some v -> Inline(Text v)
|
||||
| None -> Inline(Text $"value {args.Head} not found in metadata")
|
||||
| Some(v) -> Text v
|
||||
| None -> Text $"value {args.Head} not found in metadata"
|
||||
|
||||
|
||||
let emph = onlyChildren Emph
|
||||
|
|
@ -52,39 +30,24 @@ module ConstructionHelpers =
|
|||
let superscript = onlyChildren Superscript
|
||||
let subscript = onlyChildren Subscript
|
||||
|
||||
let image: TagRenderer =
|
||||
let image : TagRenderer =
|
||||
fun _ args kwargs children ->
|
||||
let attributes = ah "inlineImage" kwargs
|
||||
Inline(Image(attributes, children, args[0]))
|
||||
|
||||
let code: TagRenderer =
|
||||
Image(attributes,children, args[0])
|
||||
let code : TagRenderer =
|
||||
fun _ _ kwargs children ->
|
||||
let attributes = ah "inlineCode" kwargs
|
||||
|
||||
match children with
|
||||
| [ Text(c) ] -> Inline(InlineNode.Code(attributes, c))
|
||||
| [Text(c)] -> InlineNode.Code(attributes, c)
|
||||
| _ -> failwith "Code tag was not Text,"
|
||||
|
||||
let link: TagRenderer =
|
||||
let link : TagRenderer =
|
||||
fun _ args kwargs children ->
|
||||
let attributes = ah "link" kwargs
|
||||
Inline(Link(attributes, Target(args[0], children)))
|
||||
Link(attributes,Target(args[0], children))
|
||||
|
||||
|
||||
|
||||
// blocks
|
||||
let paragraph _ _ _ children = Paragraph(children)
|
||||
let plain _ _ _ children = Plain(children)
|
||||
|
||||
let table _ args kwargs children =
|
||||
let rows =
|
||||
children
|
||||
|> AstUtils.splitByNewlines
|
||||
|> List.map (fun rowNodes ->
|
||||
|
||||
let cells = rowNodes |> AstUtils.splitByPipe |> List.map Cell // Wrap each split list in a Cell node
|
||||
|
||||
Row cells)
|
||||
|
||||
let attr = makeAttr kwargs
|
||||
Block(Table(attr, rows))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue