it is now better than ever

This commit is contained in:
Linus Björnstam 2026-03-27 10:58:18 +01:00
parent b6b2958592
commit 78598d71e7
4 changed files with 543 additions and 152 deletions

View file

@ -1,26 +1,101 @@
namespace Fibble.FibLib
open System.Net
open FParsec
open YamlDotNet.Serialization
open System.Collections.Generic
module Utils =
let smartDedent (input: string) =
let lines = input.Replace("\r\n", "\n").Split('\n') |> List.ofArray
// 1. Hitta den minsta indenteringen bland alla rader som har text
let minIndent =
lines
|> List.filter (fun l -> not (System.String.IsNullOrWhiteSpace(l)))
|> List.map (fun l -> l.Length - l.TrimStart().Length)
|> function
| [] -> 0
| indents -> List.min indents
// 2. Dra av exakt många mellanslag från alla rader
let dedented =
lines
|> List.map (fun l ->
if System.String.IsNullOrWhiteSpace(l) then ""
else l.Substring(minIndent)
)
// 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet
(String.concat "\n" dedented).Trim('\n', '\r')
module Utils3 =
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
if indent = 0 then
loop tail 0 (line :: acc)
else
let newBase = if currentBase = 0 then indent else currentBase
let toStrip = min newBase indent
let stripped = line.Substring toStrip
loop tail newBase (stripped :: acc)
loop lines 0 []
// ==========================================
// 1. AST & Utils
// ==========================================
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
| Expr of code: string * result: string option
| MetaRef of string
| Element of tag: string * args: string list * children: InlineNode list
type BlockNode =
| Section of level:int * args:string list * children:InlineNode list
| Paragraph of children:InlineNode list
| Section of level: int * args: string list * children: InlineNode list
| 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 (FParsec)
// 2. Parser
// ==========================================
module Parser =
open Ast
@ -34,15 +109,51 @@ module Parser =
let isSection (name: string) = name.EndsWith("section")
// --- Nya parsers för argument och body ---
let pNewline = newline
let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
let pBody = between (pstring "{") (pstring "}") (many pInline)
// --- Inline Parsers ---
let pExpr = attempt (pstring "@(") >>. manyChars (noneOf ")") .>> pstring ")" |>> fun c -> Expr(c, None)
let pMetaRef = attempt (pstring "@value{") >>. many1Chars (noneOf "}") .>> pstring "}" |>> MetaRef
// --- 1. Måsvinge-parser (för @kommandon) ---
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
// --- 2. Parentes-parser (för @(...) med sträng-stöd) ---
let pParenBody, pParenBodyRef = createParserForwardedToRef<string, unit>()
// En inre parser som känner igen F#-strängar och escape-tecken (\")
let pFSharpString =
let normal = many1Chars (noneOf "\"\\")
let escaped = pstring "\\" >>. anyChar |>> sprintf "\\%c"
pstring "\"" .>>. manyStrings (normal <|> escaped) .>>. pstring "\""
|>> fun ((start, inner), end_) -> start + inner + end_
// Själva loopen letar nu efter strängar FÖRST, sen vanlig text, och sist inre parenteser
pParenBodyRef.Value <-
manyStrings (choice [
pFSharpString
many1Chars (noneOf "()\"")
pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)"
])
let pExpr =
attempt (pstring "@(") >>. pParenBody .>> pstring ")"
|>> fun c -> Expr(c, None)
// --- Övriga inline-parsers ---
let pMultilineCode =
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"")
|>> fun c -> Expr(Utils.smartDedent c, None)
let pInlineCommand =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
@ -50,17 +161,18 @@ module Parser =
else preturn name
)
.>>. opt pArgs
.>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) ->
let args = defaultArg argsOpt []
let body = defaultArg bodyOpt []
Element(name, args, body)
.>>. opt pBody
|>> fun ((n, a), b) -> Element(n, defaultArg a [], defaultArg b [])
let pText = many1Chars (noneOf "@{}\n\r") |>> Text
let pNewline = newline
let pSingleNewline = attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n"
pInlineRef.Value <- choice [ pExpr; pMetaRef; pInlineCommand; pText; pSingleNewline ]
// MÅSTE tilldelas efter att alla pExpr, pInlineCommand etc. är definierade
pInlineRef.Value <- choice [
pMultilineCode
pExpr
pInlineCommand
many1Chars (noneOf "@{}\n\r") |>> Text
attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n"
pchar '@' |>> fun _ -> Text "@"
]
// --- Block Parsers ---
let pSectionBlock =
@ -72,121 +184,292 @@ module Parser =
.>>. opt pArgs
.>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) ->
let args = defaultArg argsOpt []
let body = defaultArg bodyOpt []
Section(getSectionLevel name, args, body)
Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt [])
let pParagraphBlock = many1 pInline |>> Paragraph
let pBlock = choice [ pSectionBlock; pParagraphBlock ]
// --- YAML Header Parser ---
let pYamlHeader =
// Letar efter radbrytning, följt av ---, följt av radbrytning (eller filens slut)
let endMarker = attempt (newline >>. pstring "---" >>. (skipNewline <|> eof))
// Matchar --- i början, läser allt som text fram till endMarker
pstring "---" >>. newline >>. manyCharsTill anyChar endMarker
|>> fun yamlStr ->
let deserializer = DeserializerBuilder().Build()
try
// --- Dokument Parser ---
let pDocument =
spaces
>>. opt (
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
with _ -> Map.empty
// --- Dokument Parser ---
let pDocument =
spaces >>. opt pYamlHeader .>> spaces .>>. sepEndBy pBlock (many1 pNewline)
)
.>> spaces
.>>. sepEndBy pBlock (many1 pNewline)
.>> eof
|>> fun (headerOpt, blocks) ->
(defaultArg headerOpt Map.empty, blocks)
let parse (input: string) : Map<string, string> * Document =
match run pDocument input with
| Success(result, _, _) -> result
| Failure(errorMsg, _, _) -> failwithf "Kunde inte parsa dokumentet:\n%s" errorMsg
let parse i =
match run pDocument i with
| Success(r, _, _) -> r
| 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. Evaluator
// 3. Execution & Printer
// ==========================================
type IEvaluator =
abstract member Evaluate: code:string -> string
abstract member Evaluate: string -> string
module Execution =
open Ast
let rec evaluateInline (metadata: Map<string, string>) (evaluator: IEvaluator) (node: InlineNode) =
match node with
| Expr (code, _) ->
let result = evaluator.Evaluate(code)
RawHtml result
| Text t -> Text t
| RawHtml h -> RawHtml h
| MetaRef key ->
match metadata.TryFind key with
| Some value -> Text value
| None -> Text (sprintf "[Saknad meta: %s]" key)
| Element (tag, args, children) ->
Element (tag, args, children |> List.map (evaluateInline metadata evaluator))
| Text t -> Text t
let rec transform (prelude: Map<string, TagRenderer>) (eval: IEvaluator) =
function
| Element(n, a, c) when prelude.ContainsKey n -> prelude.[n] a (c |> List.map (transform prelude eval))
| Element(n, a, c) -> Element(n, a, c |> List.map (transform prelude eval))
| Expr(c, _) -> RawHtml(eval.Evaluate c)
| n -> n
let evaluateBlock (metadata: Map<string, string>) (evaluator: IEvaluator) (node: BlockNode) =
match node with
| Section (level, args, children) -> Section (level, args, children |> List.map (evaluateInline metadata evaluator))
| Paragraph children -> Paragraph (children |> List.map (evaluateInline metadata evaluator))
let evaluateDocument (metadata: Map<string, string>) (evaluator: IEvaluator) (doc: Document) =
doc |> List.map (evaluateBlock metadata evaluator)
// ==========================================
// 4. HTML Converter
// ==========================================
type TagRenderer = string list -> string -> string
type IConverter =
abstract member Convert: doc:Ast.Document * metadata:Map<string, string> -> string
module Converters =
module HtmlPrinter =
open Ast
type HtmlTemplateConverter(template: string, prelude: Map<string, TagRenderer>) =
let rec renderInline = function
| Text t -> WebUtility.HtmlEncode(t)
| RawHtml h -> h
| Expr (_, Some res) -> WebUtility.HtmlEncode(res)
| Expr (_, None) -> failwith "Oexekverat uttryck"
| MetaRef _ -> failwith "Ogiltig nod vid konvertering"
| Element (tag, args, children) ->
let renderedChildren = renderInlines children
match prelude.TryFind tag with
| Some customFunc -> customFunc args renderedChildren
| None -> sprintf "<%s>%s</%s>" tag renderedChildren tag // Fallback ignorerar args
let rec renderInline =
function
| Text t -> WebUtility.HtmlEncode t
| RawHtml h -> h
| Element(t, a, c) -> sprintf "<%s>%s</%s>" t (c |> List.map renderInline |> String.concat "") t
| _ -> ""
and renderInlines inlines =
inlines |> List.map renderInline |> String.concat ""
let render (header, blocks) =
blocks
|> List.map (function
| 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)
|> String.concat "\n"
let renderBlock = function
| Section (level, args, children) ->
let tag = sprintf "h%d" level
let idAttr = if args.Length > 0 then sprintf " id=\"%s\"" (args.[0].Trim('"')) else ""
sprintf "<%s%s>%s</%s>" tag idAttr (renderInlines children) tag
| Paragraph children ->
sprintf "<p>%s</p>" (renderInlines children)
interface IConverter with
member _.Convert(doc, metadata) =
let bodyHtml = doc |> List.map renderBlock |> String.concat "\n\n"
let mutable finalHtml = template.Replace("{{body}}", bodyHtml)
for kvp in metadata do
finalHtml <- finalHtml.Replace(sprintf "{{%s}}" kvp.Key, WebUtility.HtmlEncode(kvp.Value))
finalHtml
module Evaluators =
open System.IO
open System.Text
open FSharp.Compiler.Interactive.Shell
// ==========================================
// 5. Pipeline & Test
// ==========================================
module FibLib=
let processDocument (source: string) (template: string) (evaluator: IEvaluator) (converter: IConverter) =
let (metadata, rawAst) = Parser.parse source
let evaluatedAst = Execution.evaluateDocument metadata evaluator rawAst
converter.Convert(evaluatedAst, metadata)
type FsiEvaluator() =
let sbOut = new StringBuilder()
let sbErr = new StringBuilder()
let inStream = new StringReader("")
let outStream = new StringWriter(sbOut)
let errStream = new StringWriter(sbErr)
// Initiera FSI-sessionen
let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
let argv = [| "fsi.exe"; "--noninteractive" |]
let session = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)
interface IEvaluator with
member _.Evaluate(code: string) =
sbOut.Clear() |> ignore
sbErr.Clear() |> ignore
try
let result, _warnings = session.EvalInteractionNonThrowing(code)
let output = sbOut.ToString()
let errors = sbErr.ToString().Trim()
// Filtrera bort FSI:s automatiska typsignaturer från utskriften
let cleanOutput =
output.Replace("\r\n", "\n").Split('\n')
|> Array.filter (fun line ->
let l = line.TrimStart()
not (l.StartsWith("val ") || l.StartsWith("type ") || l.StartsWith("module ") || l.StartsWith("namespace "))
)
|> String.concat "\n"
|> fun s -> s.Trim()
match result with
| Choice1Of2 (Some fsiValue) ->
// Plocka ut värdet. Om det är en sträng, undvik "%A" för att slippa citattecken.
let valStr =
if isNull fsiValue.ReflectionValue then ""
else
match fsiValue.ReflectionValue with
| :? string as s -> s
| v -> sprintf "%A" v
if System.String.IsNullOrEmpty(cleanOutput) then valStr
elif System.String.IsNullOrEmpty(valStr) then cleanOutput
else cleanOutput + "\n" + valStr
| Choice1Of2 None ->
if not (System.String.IsNullOrEmpty(errors)) then
cleanOutput + sprintf "%A" errors
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
// 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