395 lines
15 KiB
FSharp
395 lines
15 KiB
FSharp
namespace Fibble.FibLib
|
|
|
|
open System.Net
|
|
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<string, string> * children: InlineNode list
|
|
and BlockNode =
|
|
| 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 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 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 ""
|
|
|
|
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 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")
|
|
|
|
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
|
|
|
|
// --- 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 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 pMultilineCode =
|
|
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"")
|
|
|>> fun c -> Expr(c, None)
|
|
|
|
// 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)
|
|
|
|
// Nu när pInlineCommand, pExpr och pMultilineCode är definierade
|
|
// kan vi skapa pInnerInline
|
|
let pInnerInline =
|
|
choice [
|
|
attempt pInlineCommand
|
|
attempt pExpr
|
|
pMultilineCode
|
|
many1Chars (noneOf "@}") |>> Text
|
|
pchar '@' |>> fun _ -> Text "@"
|
|
]
|
|
|
|
// Tilldela värdet till pBodyRef
|
|
pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline)
|
|
|
|
// Tilldela värdet till pInlineRef
|
|
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
|
|
.>>. opt pBody
|
|
|>> fun ((name, argsOpt), bodyOpt) ->
|
|
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
|
|
|
|
|
|
// ==========================================
|
|
// 3. Execution & Printer
|
|
// ==========================================
|
|
type IEvaluator =
|
|
abstract member Evaluate: string -> string
|
|
|
|
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 FsiEvaluator() =
|
|
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)
|
|
|
|
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
|
|
|
|
|