Compare commits

..

2 commits

Author SHA1 Message Date
6b952bd6fd playing with the interface 2026-03-28 14:20:34 +01:00
14697b3dd9 added metadata 2026-03-27 12:17:36 +01:00
5 changed files with 170 additions and 244 deletions

View file

@ -6,13 +6,13 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Pandoc.fs" />
<Compile Include="Library.fs" /> <Compile Include="Library.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FParsec" Version="1.1.1" /> <PackageReference Include="FParsec" Version="1.1.1" />
<PackageReference Include="FSharp.Compiler.Service" Version="43.12.201" /> <PackageReference Include="FSharp.Compiler.Service" Version="43.12.201" />
<PackageReference Include="System.Text.Json" Version="10.0.5" />
<PackageReference Include="YamlDotNet" Version="16.3.0" /> <PackageReference Include="YamlDotNet" Version="16.3.0" />
</ItemGroup> </ItemGroup>

View file

@ -6,9 +6,45 @@ open YamlDotNet.Serialization
open System.Collections.Generic open System.Collections.Generic
// ==========================================
// 1. AST & Utils
// ==========================================
module Ast =
type InlineNode =
| Text of string
| RawHtml of string
| Expr of code: string * result: string option
| Element of tag: string * args: (string * string) list * children: InlineNode list
type BlockNode =
| Section of level: int * args: (string * string) list * children: InlineNode list
| Paragraph of children: InlineNode list
type Document = BlockNode list
type TagRenderer = Map<string,string> -> (string * string) list -> InlineNode list -> InlineNode
let rec stringifyNodes (nodes: InlineNode list) =
let tupleToString (t: string * string) = sprintf "%s=\"%s\"" (fst t) (snd t)
nodes
|> List.map (function
| Text t -> t
| RawHtml h -> h
| Element(tag, args, children) ->
// Omvandla inre taggar till HTML
let attrs = if args.IsEmpty then "" else " " + String.concat " " (List.map tupleToString args)
sprintf "<%s%s>%s</%s>" tag attrs (stringifyNodes children) tag
| Expr(_, Some res) -> res
| Expr(code, None) -> sprintf "@(%s)" code // Fallback om den inte evaluerats
)
|> String.concat ""
module Utils = module Utils =
open Ast
let smartDedent (input: string) = let smartDedent (input: string) =
let lines = input.Replace("\r\n", "\n").Split('\n') |> List.ofArray let lines = input.Replace("\r\n", "\n").Split '\n' |> List.ofArray
// 1. Hitta den minsta indenteringen bland alla rader som har text // 1. Hitta den minsta indenteringen bland alla rader som har text
let minIndent = let minIndent =
@ -20,6 +56,7 @@ module Utils =
| indents -> List.min indents | indents -> List.min indents
// 2. Dra av exakt många mellanslag från alla rader // 2. Dra av exakt många mellanslag från alla rader
// för att dessa inte ska vara med i det slutgiltiga dokumentet.
let dedented = let dedented =
lines lines
|> List.map (fun l -> |> List.map (fun l ->
@ -30,67 +67,32 @@ module Utils =
// 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet // 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet
(String.concat "\n" dedented).Trim('\n', '\r') (String.concat "\n" dedented).Trim('\n', '\r')
module Utils3 = let positional f: TagRenderer =
let smartDedent (input: string) = fun meta (args: (string*string) list) children -> f meta (List.map snd args) children
let text = input.Trim('\n', '\r')
let lines = text.Replace("\r\n", "\n").Split('\n') |> List.ofArray
let rec loop lines currentBase acc = let getArgIdx (args: (string*string) list) index defaultVal =
match lines with let unnamed = args |> List.filter (fun (k, _) -> k = "")
| [] -> List.rev acc |> String.concat "\n" if index < unnamed.Length then (snd unnamed.[index]).Trim('"')
| line :: tail -> else defaultVal
if System.String.IsNullOrWhiteSpace(line) then
loop tail currentBase ("" :: acc)
else
let indent = line.Length - line.TrimStart().Length
if indent = 0 then // 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
loop tail 0 (line :: acc) let getArg (args: (string * string) list) (key: string) (index: int) (defaultVal: string) =
else match args |> List.tryFind (fun (k, _) -> k = key) with
let newBase = if currentBase = 0 then indent else currentBase | Some (_, v) -> v.Trim('"')
let toStrip = min newBase indent | None -> getArgIdx args index defaultVal
let stripped = line.Substring toStrip
loop tail newBase (stripped :: acc)
loop lines 0 [] 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) =
// 1. AST & Utils fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children
// ==========================================
module Ast =
type InlineNode =
| Text of string
| RawHtml of string
| Expr of code: string * result: string option
| MetaRef of string
| Element of tag: string * args: string list * children: InlineNode list
type BlockNode = let nameToElement (n:string) : TagRenderer =
| Section of level: int * args: string list * children: InlineNode list fun meta args children -> Element(n, args, children)
| Paragraph of children: InlineNode list
type Document = BlockNode list
type TagRenderer = string list -> InlineNode list -> InlineNode
module Utils2 =
let smartDedent (input: string) =
let text = input.Trim('\n', '\r')
let lines = text.Replace("\r\n", "\n").Split '\n' |> List.ofArray
let rec loop lines currentBase acc =
match lines with
| [] -> List.rev acc |> String.concat "\n"
| line :: tail ->
if System.String.IsNullOrWhiteSpace line then
loop tail currentBase ("" :: acc)
else
let indent = line.Length - line.TrimStart().Length
let newBase = if currentBase = 0 then indent else currentBase
let toStrip = min newBase indent
loop tail newBase (line.Substring toStrip :: acc)
loop lines 0 []
// ========================================== // ==========================================
// 2. Parser // 2. Parser
@ -110,7 +112,17 @@ module Parser =
let isSection (name: string) = name.EndsWith("section") let isSection (name: string) = name.EndsWith("section")
let pNewline = newline let pNewline = newline
let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces let pArg =
spaces >>.
choice [
attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_")
.>> spaces .>> pchar '=' .>> spaces
.>>. manyChars (noneOf ",]"))
|>> fun (k, v) -> (k, v.Trim())
// Fallback: bara "värde" (ges en tom nyckel)
manyChars (noneOf ",]") |>> fun v -> ("", v.Trim())
] .>> spaces
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ",")) let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
// --- 1. Måsvinge-parser (för @kommandon) --- // --- 1. Måsvinge-parser (för @kommandon) ---
@ -123,7 +135,15 @@ module Parser =
let pBody = let pBody =
between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw -> between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw ->
match run (many pInline .>> eof) (Utils.smartDedent raw) with // En mer tillåtande parser isolerad för innehållet inuti {...}
let pInnerInline =
choice [
attempt pInline
// Fångar upp dubbla radbrytningar och måsvingar som pInline normalt blockerar
many1Chars (anyOf "\r\n{}") |>> Text
]
match run (many pInnerInline .>> eof) (Utils.smartDedent raw) with
| Success(n, _, _) -> preturn n | Success(n, _, _) -> preturn n
| Failure(m, _, _) -> fail m | Failure(m, _, _) -> fail m
@ -214,112 +234,6 @@ module Parser =
| Failure(e, _, _) -> failwith e | Failure(e, _, _) -> failwith e
module Parser2 =
open Ast
let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit>()
// --- De saknade hjälpfunktionerna ---
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 isSection (name: string) = name.EndsWith "section"
let pNewline = newline
let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
// ------------------------------------
let pRawBody, pRawBodyRef = createParserForwardedToRef<string, unit>()
pRawBodyRef.Value <-
many (choice [
many1Chars (noneOf "{}")
pchar '{' >>. pRawBodyRef.Value .>> pchar '}' |>> sprintf "{%s}"
]) |>> String.concat ""
let pBody =
between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw ->
match run (many pInline .>> eof) (Utils.smartDedent raw) with
| Success(n, _, _) -> preturn n
| Failure(m, _, _) -> fail m
let pMultilineCode =
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"")
|>> fun c -> Expr(Utils.smartDedent c, None)
let pParenBody, pParenBodyRef = createParserForwardedToRef<string, unit>()
pParenBodyRef.Value <-
many (choice [
many1Chars (noneOf "()")
pchar '(' >>. pParenBodyRef.Value .>> pchar ')' |>> sprintf "(%s)"
]) |>> String.concat ""
// let pExpr2 =
// attempt (pstring "@(") >>. manyChars (noneOf ")") .>> pstring ")"
// |>> fun c -> Expr(c, None)
let pExpr =
attempt (pstring "@(") >>. pParenBodyRef.Value .>> pstring ")"
|>> fun c -> Expr(c, None)
let pInlineCommand =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
if isSection name then fail "Sektioner är block-element."
else preturn name
)
.>>. opt pArgs
.>>. opt pBody
|>> fun ((n, a), b) -> Element(n, defaultArg a [], defaultArg b [])
pInlineRef.Value <- choice [
pMultilineCode
pExpr
pInlineCommand
many1Chars (noneOf "@{}\n\r") |>> Text
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n"
]
let pSectionBlock =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
if isSection name then preturn name
else fail "Inte en sektion."
)
.>>. opt pArgs
.>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) ->
Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt [])
let pParagraphBlock = many1 pInline |>> Paragraph
let pBlock = choice [ pSectionBlock; pParagraphBlock ]
let pDocument =
spaces
>>. opt (
pstring "---"
// HÄR ÄR FIXEN: attempt runt pNewline och 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
)
.>> spaces
.>>. sepEndBy pBlock (many1 pNewline)
|>> fun (headerOpt, blocks) ->
(defaultArg headerOpt Map.empty, blocks)
let parse i =
match run pDocument i with
| Success(r, _, _) -> r
| Failure(e, _, _) -> failwith e
// ========================================== // ==========================================
// 3. Execution & Printer // 3. Execution & Printer
// ========================================== // ==========================================
@ -329,26 +243,45 @@ type IEvaluator =
module Execution = module Execution =
open Ast open Ast
let rec transform (prelude: Map<string, TagRenderer>) (eval: IEvaluator) = let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (eval: IEvaluator) = function
function | Element(n, a, c) when prelude.ContainsKey n ->
| Element(n, a, c) when prelude.ContainsKey n -> prelude.[n] a (c |> List.map (transform prelude eval)) prelude.[n] metadata a (c |> List.map (transform metadata prelude eval))
| Element(n, a, c) -> Element(n, a, c |> List.map (transform prelude eval)) | Element(n, a, c) ->
| Expr(c, _) -> RawHtml(eval.Evaluate c) Element(n, a, c |> List.map (transform metadata prelude eval))
| Expr(c, _) -> RawHtml (eval.Evaluate c)
| n -> n | n -> n
module HtmlPrinter = module HtmlPrinter =
open Ast open Ast
let voidElements = [ "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img"; "input"; "keygen"; "link"; "meta"; "param"; "source"; "track"; "wbr"]
let renderAttributes args =
args
|> List.map (fun m -> sprintf "%s=\"%s\"" (fst m) (snd m))
|> String.concat " "
let rec renderInline = let rec renderInline =
function function
| Text t -> WebUtility.HtmlEncode t | Text t -> WebUtility.HtmlEncode t
| RawHtml h -> h | RawHtml h -> h
| Element(t, a, c) -> sprintf "<%s>%s</%s>" t (c |> List.map renderInline |> String.concat "") t | Element(t,a,c) when List.contains t voidElements -> sprintf "<%s %s />" t (renderAttributes a)
| Element(t, a, c) -> sprintf "<%s %s>%s</%s>" t (renderAttributes a) (c |> List.map renderInline |> String.concat "") t
| _ -> "" | _ -> ""
let render (header, blocks) = let render (header, blocks) =
blocks blocks
|> List.map (function |> List.map (function
| Paragraph [RawHtml html] ->
html
// 2. (Frivillig) Mer robust guard om parsern råkar lämna kvar
// blanksteg (Text " ") runt ditt @md-block i samma paragraf
| Paragraph nodes when nodes |> List.forall (function
| RawHtml _ -> true
| Text t when System.String.IsNullOrWhiteSpace(t) -> true
| _ -> false) ->
nodes
|> List.choose (function RawHtml h -> Some h | _ -> None)
|> String.concat "\n"
| Paragraph c -> sprintf "<p>%s</p>" (c |> List.map renderInline |> String.concat "") | 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) | Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l)
|> String.concat "\n" |> String.concat "\n"
@ -427,49 +360,4 @@ module Evaluators =
<strong>Kritiskt FSI-systemfel:</strong> %s <strong>Kritiskt FSI-systemfel:</strong> %s
</div>""" ex.Message </div>""" ex.Message
// interface IEvaluator with
// member _.Evaluate(code: string) =
// sbOut.Clear() |> ignore
// sbErr.Clear() |> ignore
// try
// printfn "%s" code
// // Kör koden i FSI
// let result, _warnings = session.EvalInteractionNonThrowing code
// // Läs av vad kompilatorn spottade ut
// let output = sbOut.ToString().Trim()
// let errors = sbErr.ToString().Trim()
// match result with
// | Choice1Of2 (Some fsiValue) ->
// // Det gick bra och koden returnerade ett värde
// let valStr = sprintf "%A" fsiValue.ReflectionValue
// if System.String.IsNullOrEmpty(output) then valStr
// else output + "\n" + valStr
// | Choice1Of2 None ->
// // Det gick bra, men koden returnerade inget värde (t.ex. en let-bindning)
// // Om det fanns utskrifter i sbErr (t.ex. varningar), kan vi visa dem här:
// if not (System.String.IsNullOrEmpty(errors)) then
// output + sprintf "\n %A" errors
// else
// output
// | Choice2Of2 ex ->
// // FSI kastade ett exception (t.ex. syntaxfel eller runtime-fel)
// 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 ->
// // Fångar upp om själva anropet till session.EvalInteractionNonThrowing kraschar helt
// sprintf """<div style="color: red; border: 1px solid red; padding: 10px;">
// <strong>Kritiskt FSI-systemfel:</strong> %s
// </div>""" ex.Message

38
src/FibLib/Pandoc.fs Normal file
View file

@ -0,0 +1,38 @@
namespace Fibble.FibLib
module Pandoc =
open System.Diagnostics
let toHtml (from: string) (markdownText: string) =
let startInfo = ProcessStartInfo(
FileName = "pandoc",
Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua",
RedirectStandardInput = true,
RedirectStandardOutput = true,
RedirectStandardError = true,
UseShellExecute = false,
CreateNoWindow = true)
try
use proc = Process.Start startInfo
// Skriv markdown till Pandoc
use stdin = proc.StandardInput
stdin.Write markdownText
stdin.Close() // Måste stängas Pandoc vet att texten är slut
// Läs ut resultatet
let htmlOutput = proc.StandardOutput.ReadToEnd()
let errorOutput = proc.StandardError.ReadToEnd()
proc.WaitForExit()
if proc.ExitCode = 0 then
htmlOutput.Trim()
else
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" errorOutput markdownText
with ex ->
// Fångar upp om Pandoc inte är installerat eller inte finns i PATH
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText
let mdToHtml markdownText =
toHtml "markdown" markdownText

5
src/FibLib/strip-p.lua Normal file
View file

@ -0,0 +1,5 @@
function Pandoc(doc)
if #doc.blocks > 0 and doc.blocks[1].t == "Para" then
return pandoc.Pandoc(doc.blocks[1].content, doc.meta)
end
end

View file

@ -7,41 +7,36 @@ open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc.
// ========================================== // ==========================================
// makeElem returnerar nu en strukturerad Element-nod istället för en sträng // makeElem returnerar nu en strukturerad Element-nod istället för en sträng
let makeElem (name : string) = let elem (name : string) =
(name, fun args children -> Element(name, args, children)) (name, fun meta args children -> Element(name, args, children))
let makeElems lst = let makeElems lst =
List.map makeElem lst List.map elem lst
let defaultPrelude : Map<string, TagRenderer> =
[ "b"; "em"; "i"; "strong" ]
|> makeElems
|> Map.ofList
let myPrelude : Map<string, TagRenderer> = let myPrelude : Map<string, TagRenderer> =
Map.ofList [ Map [
"quotient", fun args _ -> "quotient", fun _ args _ ->
if args.Length >= 2 then if args.Length >= 2 then
Text (sprintf "%d" (int args.[0] / int args.[1])) Text (sprintf "%d" (int args.[0] / int args.[1]))
else else
Text "[Fel: quotient kräver två argument]" Text "[Fel: quotient kräver två argument]"
"bold", fun _ args children ->
"bold", fun args children ->
Element("b", args, children) Element("b", args, children)
"value", fun meta args _ ->
"link", fun args children -> Text meta[args.Head]
"link", fun _ args children ->
let url = if args.Length > 0 then args.[0].Trim('"') else "#" let url = if args.Length > 0 then args.[0].Trim('"') else "#"
// Vi mappar argumenten till HTML-attribut (t.ex. href="...")
Element("a", [sprintf "href=\"%s\"" url], children) Element("a", [sprintf "href=\"%s\"" url], children)
// @br har varken argument eller barn, vi returnerar bara HTML direkt // @br har varken argument eller barn, vi returnerar bara HTML direkt
"br", fun _ _ -> "br", fun _ _ _ -> RawHtml "<br/>"
RawHtml "<br/>" ]
]
// ========================================== // ==========================================
// 2. Mall och Evaluator // 2. Mall och Evaluator
// ========================================== // ==========================================
let pageTemplate = """ <!DOCTYPE html> let pageTemplate = """ <!DOCTYPE html>
<htm> <htm>
<head> <head>
@ -119,7 +114,7 @@ let increment () =
Första anropet: @(increment()) Första anropet: @(increment())
Andra anropet: @(increment()) Andra anropet: @(increment())
Test av utskrift: Test av utskrift: @value[date]
" "
// ========================================== // ==========================================
// 3. Huvudpipeline // 3. Huvudpipeline
@ -128,7 +123,7 @@ let processDocument (source: string) =
let evaluator = Evaluators.FsiEvaluator() let evaluator = Evaluators.FsiEvaluator()
// Steg 1: Parsa koden // Steg 1: Parsa koden
let (metadata, rawBlocks) = Parser.parse source let metadata, rawBlocks = Parser.parse source
// Hjälpfunktion: igenom trädet och byt ut @value{...} mot faktiskt data från YAML // Hjälpfunktion: igenom trädet och byt ut @value{...} mot faktiskt data från YAML
let rec resolveMeta = function let rec resolveMeta = function
@ -146,11 +141,11 @@ let processDocument (source: string) =
| Paragraph children -> | Paragraph children ->
Paragraph (children Paragraph (children
|> List.map resolveMeta |> List.map resolveMeta
|> List.map (Execution.transform myPrelude evaluator)) |> List.map (Execution.transform metadata myPrelude evaluator))
| Section(l, a, children) -> | Section(l, a, children) ->
Section(l, a, children Section(l, a, children
|> List.map resolveMeta |> List.map resolveMeta
|> List.map (Execution.transform myPrelude evaluator)) |> List.map (Execution.transform metadata myPrelude evaluator))
) )
// Steg 3: Be printern skriva ut trädet till HTML // Steg 3: Be printern skriva ut trädet till HTML