namespace Fibble.FibLib open System open FParsec open YamlDotNet.Serialization open System.Collections.Generic // ========================================== // 1. AST & Utils // ========================================== module Ast = type Attr = { id: string classes: string list kvp: (string * string) list } type InlineNode = | Text of string | RawHtml of string | Emph of InlineNode list | Underline of InlineNode list | Strong of InlineNode list | Strikeout of InlineNode list | Superscript of InlineNode list | Subscript of InlineNode list | Link of attributes: Attr * target: Target | Code of attributes: Attr * text: string | Image of attributes: Attr * altText: InlineNode list * target: Url | Note of BlockNode list | SoftBreak | LineBreak | Expr of code: string * result: string option | Command of tag: string * args: string list * kwargs: Map * children: InlineNode list and BlockNode = | BlockCommand of tag: string * args: string list * kwargs: Map * 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 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 } type NodeResult = | Inline of InlineNode | Block of BlockNode type TagRenderer = Map -> string list -> Map -> InlineNode list -> NodeResult module Utils = open Ast let dedentNodes (nodes: InlineNode list) = let fullText = 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 else 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 let mutable isFirstText = true let indentStr = "\n" + String.replicate minIndent " " // 2. Applicera formateringen let dedented = nodes |> List.map (function | Text t -> let t1 = t.Replace("\r\n", "\n") // Ta bort inledande mellanslag på den allra första texten direkt efter '{' let t2 = if isFirstText then isFirstText <- false t1.TrimStart(' ', '\t') 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) // 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna let rec trimStart = function | Text t :: rest -> let trimmed = t.TrimStart('\n', '\r', ' ', '\t') if trimmed = "" then trimStart rest else Text trimmed :: rest | other -> other let rec trimEnd = function | Text t :: rest -> let trimmed = t.TrimEnd('\n', '\r', ' ', '\t') if trimmed = "" then trimEnd rest else Text trimmed :: rest | other -> other dedented |> trimStart |> List.rev |> trimEnd |> List.rev 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 unnamed = args |> List.filter (fun (k, _) -> k = "") 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('"') | 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) = fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children // ========================================== // 2. Parser // ========================================== module Parser = open Ast let pseudoRandom = new System.Random() let pInline, pInlineRef = createParserForwardedToRef () 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 let isSection (name: string) = name.EndsWith("section") let pNewline = newline let pNamedArg = // Leta efter "nyckel=värde" attempt ( many1Chars (asciiLetter <|> digit <|> anyOf "-_") .>> spaces .>> pchar '=' .>> spaces ) .>>. manyChars (noneOf ",]") |>> fun (k, v) -> k, v.Trim() let pPositionalArg = // Bara "värde" manyChars (noneOf ",]") |>> fun v -> "", v.Trim() let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces let pArgs = between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ',')) >>= fun args -> // Validera att positionella argument alltid kommer först 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 validate true args let pBody, pBodyRef = createParserForwardedToRef () // --- 2. Parentes-parser (för @(...) med sträng-stöd) --- let pParenBody, pParenBodyRef = createParserForwardedToRef () 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 many1Chars (noneOf "()\"") 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 "\"\"\"") |>> fun c -> Expr(c, None) // Matchar ( pchar '(' >>. pParenBody .>> pchar ')' |>> fun c -> Expr(c, None) // Matchar ASCII-bokstäver (för kommandon) many1Chars asciiLetter .>>. opt pArgs .>>. opt pBody |>> fun ((name, argsOpt), bodyOpt) -> let rawArgs = defaultArg argsOpt [] let posArgs = rawArgs |> List.choose (fun (k, v) -> if k = "" then Some v else None) let kwargs = rawArgs |> List.filter (fun (k, _) -> k <> "") |> Map.ofList let children = defaultArg bodyOpt [] |> Utils.dedentNodes Command(name, posArgs, kwargs, children) // Fallback: det var bara ett löst @ i texten preturn (Text "@") ] // / Hjälpare för att bara svälja mellanslag och tabbar (inte radbrytningar) let pHorizontalSpace = skipMany (anyOf " \t") let pCommandHead = pchar '@' >>. many1Chars (asciiLetter <|> digit) let pBlockCommand = // 1. Tillåt indrag, men inga radbrytningar pHorizontalSpace >>. pCommandHead .>>. opt pArgs .>>. opt pBody // 2. MAGIN: Se till att det inte finns mer text på raden efter kommandot .>> pHorizontalSpace .>> choice [ skipNewline; eof ] // Måste följas av radbrytning eller filslut |>> fun ((name, argsOpt), bodyOpt) -> let args, kwargsList = separateArgs (defaultArg argsOpt []) // Se till att eventuell dedent/städning appliceras här om du har Utils.dedentNodes let children = defaultArg bodyOpt [] BlockCommand(name, args, Map.ofList kwargsList, children) let pInnerInline = choice [ pAtCommand // Hanterar alla @-baserade noder many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline) pInlineRef.Value <- choice [ pAtCommand many1Chars (noneOf "@{}\n\r") |>> Text attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ] // --- 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." ) .>>. 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, []) let pParagraphBlock = many1 pInline |>> Paragraph let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ] let pDocument = spaces >>. opt ( pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---")) |>> fun yamlStr -> let deserializer = DeserializerBuilder().Build() let dict = deserializer.Deserialize>(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 [] type IEvaluator() = abstract member Evaluate: string -> string abstract member NewSession: unit -> unit 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("") 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) override this.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 a tattecken. 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 """
FSI Exekveringsfel!
Kod som kördes: %s

Exception: %s
FSI Stderr: 
%s
""" code ex.Message fsiErrorOutput with ex -> sprintf """
Kritiskt FSI-systemfel: %s
""" ex.Message override this.NewSession() = this.Evaluate($"module {Random.Shared.GetHexString(10)}") () module CommandEvaluator = open Ast // Interface för att utvärdera Expr-noder (kodblock/matte) // Huvudfunktionen let rec evaluateDocument (metadata: Map) (prelude: Map) (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