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 så 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 type BlockNode = | 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 // ========================================== module Parser = open Ast 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 isSection (name: string) = name.EndsWith("section") let pNewline = newline let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ",")) // --- 1. Måsvinge-parser (för @kommandon) --- let pRawBody, pRawBodyRef = createParserForwardedToRef() 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() // 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 -> 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 []) // 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 .>>. 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>(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 module Parser2 = open Ast let pInline, pInlineRef = createParserForwardedToRef() // --- 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() 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() 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>(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 // ========================================== type IEvaluator = abstract member Evaluate: string -> string module Execution = open Ast let rec transform (prelude: Map) (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 module HtmlPrinter = open Ast let rec renderInline = function | Text t -> WebUtility.HtmlEncode t | RawHtml h -> h | Element(t, a, c) -> sprintf "<%s>%s" t (c |> List.map renderInline |> String.concat "") t | _ -> "" let render (header, blocks) = blocks |> List.map (function | Paragraph c -> sprintf "

%s

" (c |> List.map renderInline |> String.concat "") | Section(l, _, c) -> sprintf "%s" 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 """
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 // 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 """ //
// FSI Exekveringsfel!
// Kod som kördes: %s

// Exception: %s
// FSI Stderr: 
%s
//
""" code ex.Message fsiErrorOutput // with ex -> // // Fångar upp om själva anropet till session.EvalInteractionNonThrowing kraschar helt // sprintf """
// Kritiskt FSI-systemfel: %s //
""" ex.Message