Fibble/src/FibLib/Library.fs

364 lines
15 KiB
Forth
Raw Normal View History

2026-03-24 13:33:01 +01:00
namespace Fibble.FibLib
2026-03-27 10:58:18 +01:00
2026-03-24 13:33:01 +01:00
open System.Net
open FParsec
open YamlDotNet.Serialization
open System.Collections.Generic
2026-03-27 10:58:18 +01:00
2026-03-28 14:20:34 +01:00
// ==========================================
// 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 ""
2026-03-27 10:58:18 +01:00
module Utils =
2026-03-28 14:20:34 +01:00
open Ast
2026-03-27 10:58:18 +01:00
let smartDedent (input: string) =
2026-03-27 12:17:36 +01:00
let lines = input.Replace("\r\n", "\n").Split '\n' |> List.ofArray
2026-03-27 10:58:18 +01:00
// 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
2026-03-27 12:17:36 +01:00
// för att dessa inte ska vara med i det slutgiltiga dokumentet.
2026-03-27 10:58:18 +01:00
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')
2026-03-28 14:20:34 +01:00
let positional f: TagRenderer =
fun meta (args: (string*string) list) children -> f meta (List.map snd args) children
2026-03-24 13:33:01 +01:00
2026-03-28 14:20:34 +01:00
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
2026-03-24 13:33:01 +01:00
2026-03-28 14:20:34 +01:00
// 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('"')
| None -> getArgIdx args index defaultVal
let withArg1 def (f: string -> InlineNode list -> InlineNode) =
fun _ args children -> f (getArgIdx args 0 def) children
2026-03-24 13:33:01 +01:00
2026-03-28 14:20:34 +01:00
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
let nameToElement (n:string) : TagRenderer =
fun meta args children -> Element(n, args, children)
2026-03-27 12:17:36 +01:00
2026-03-27 10:58:18 +01:00
2026-03-24 13:33:01 +01:00
// ==========================================
2026-03-27 10:58:18 +01:00
// 2. Parser
2026-03-24 13:33:01 +01:00
// ==========================================
2026-03-27 10:58:18 +01:00
2026-03-24 13:33:01 +01:00
module Parser =
open Ast
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 isSection (name: string) = name.EndsWith("section")
2026-03-27 10:58:18 +01:00
let pNewline = newline
2026-03-28 14:20:34 +01:00
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
2026-03-24 13:33:01 +01:00
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
2026-03-27 10:58:18 +01:00
// --- 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 ""
2026-03-28 14:20:34 +01:00
let pBody =
2026-03-27 10:58:18 +01:00
between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw ->
2026-03-28 14:20:34 +01:00
// 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
2026-03-27 10:58:18 +01:00
| 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)
2026-03-24 13:33:01 +01:00
let pInlineCommand =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
if isSection name then fail "Sektioner är block-element."
else preturn name
)
.>>. opt pArgs
2026-03-27 10:58:18 +01:00
.>>. opt pBody
|>> fun ((n, a), b) -> Element(n, defaultArg a [], defaultArg b [])
// 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 =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
if isSection name then preturn name
else fail "Inte en sektion."
)
.>>. opt pArgs
2026-03-24 13:33:01 +01:00
.>>. opt pBody
|>> fun ((name, argsOpt), bodyOpt) ->
2026-03-27 10:58:18 +01:00
Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt [])
let pParagraphBlock = many1 pInline |>> Paragraph
let pBlock = choice [ pSectionBlock; pParagraphBlock ]
// --- 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
)
.>> spaces
.>>. sepEndBy pBlock (many1 pNewline)
.>> eof
|>> fun (headerOpt, blocks) ->
(defaultArg headerOpt Map.empty, blocks)
let parse i =
match run pDocument i with
| Success(r, _, _) -> r
| Failure(e, _, _) -> failwith e
2026-03-24 13:33:01 +01:00
// ==========================================
2026-03-27 10:58:18 +01:00
// 3. Execution & Printer
2026-03-24 13:33:01 +01:00
// ==========================================
type IEvaluator =
2026-03-27 10:58:18 +01:00
abstract member Evaluate: string -> string
2026-03-24 13:33:01 +01:00
module Execution =
open Ast
2026-03-27 12:17:36 +01:00
let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (eval: IEvaluator) = function
| Element(n, a, c) when prelude.ContainsKey n ->
prelude.[n] metadata a (c |> List.map (transform metadata prelude eval))
| Element(n, a, c) ->
Element(n, a, c |> List.map (transform metadata prelude eval))
| Expr(c, _) -> RawHtml (eval.Evaluate c)
2026-03-27 10:58:18 +01:00
| n -> n
2026-03-24 13:33:01 +01:00
2026-03-27 10:58:18 +01:00
module HtmlPrinter =
2026-03-24 13:33:01 +01:00
open Ast
2026-03-28 14:20:34 +01:00
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 " "
2026-03-27 10:58:18 +01:00
let rec renderInline =
function
| Text t -> WebUtility.HtmlEncode t
| RawHtml h -> h
2026-03-28 14:20:34 +01:00
| 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
2026-03-27 10:58:18 +01:00
| _ -> ""
let render (header, blocks) =
blocks
|> List.map (function
2026-03-28 14:20:34 +01:00
| 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"
2026-03-27 10:58:18 +01:00
| 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"
module Evaluators =
open System.IO
open System.Text
open FSharp.Compiler.Interactive.Shell
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
2026-03-27 12:17:36 +01:00