diff --git a/src/FibLib/FibLib.fsproj b/src/FibLib/FibLib.fsproj index d424556..ee25264 100644 --- a/src/FibLib/FibLib.fsproj +++ b/src/FibLib/FibLib.fsproj @@ -6,13 +6,13 @@ - + diff --git a/src/FibLib/Library.fs b/src/FibLib/Library.fs index fd5a9ef..e1f6c71 100644 --- a/src/FibLib/Library.fs +++ b/src/FibLib/Library.fs @@ -6,45 +6,9 @@ open YamlDotNet.Serialization open System.Collections.Generic -// ========================================== -// 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) 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" tag attrs (stringifyNodes children) tag - | Expr(_, Some res) -> res - | Expr(code, None) -> sprintf "@(%s)" code // Fallback om den inte evaluerats - ) - |> String.concat "" - - - module Utils = - open Ast let smartDedent (input: string) = - let lines = input.Replace("\r\n", "\n").Split '\n' |> List.ofArray + let lines = input.Replace("\r\n", "\n").Split('\n') |> List.ofArray // 1. Hitta den minsta indenteringen bland alla rader som har text let minIndent = @@ -56,7 +20,6 @@ module Utils = | indents -> List.min indents // 2. Dra av exakt så många mellanslag från alla rader - // för att dessa inte ska vara med i det slutgiltiga dokumentet. let dedented = lines |> List.map (fun l -> @@ -66,33 +29,68 @@ module Utils = // 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet (String.concat "\n" dedented).Trim('\n', '\r') - - let positional f: TagRenderer = - fun meta (args: (string*string) list) children -> f meta (List.map snd args) children - - 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 - - let nameToElement (n:string) : TagRenderer = - fun meta args children -> Element(n, args, children) +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 @@ -112,17 +110,7 @@ module Parser = let isSection (name: string) = name.EndsWith("section") let pNewline = newline - 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 + let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ",")) // --- 1. Måsvinge-parser (för @kommandon) --- @@ -135,15 +123,7 @@ module Parser = let pBody = between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw -> - // 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 + match run (many pInline .>> eof) (Utils.smartDedent raw) with | Success(n, _, _) -> preturn n | Failure(m, _, _) -> fail m @@ -234,6 +214,112 @@ module Parser = | 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 // ========================================== @@ -243,45 +329,26 @@ type IEvaluator = module Execution = open Ast - let rec transform (metadata: Map) (prelude: Map) (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) + 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 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 " " + let rec renderInline = function | Text t -> WebUtility.HtmlEncode t | RawHtml h -> h - | Element(t,a,c) when List.contains t voidElements -> sprintf "<%s %s />" t (renderAttributes a) - | Element(t, a, c) -> sprintf "<%s %s>%s" t (renderAttributes a) (c |> List.map renderInline |> String.concat "") t + | Element(t, a, c) -> sprintf "<%s>%s" t (c |> List.map renderInline |> String.concat "") t | _ -> "" let render (header, blocks) = blocks |> List.map (function - | 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" | 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" @@ -360,4 +427,49 @@ module Evaluators = 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 diff --git a/src/FibLib/Pandoc.fs b/src/FibLib/Pandoc.fs deleted file mode 100644 index 6b510e4..0000000 --- a/src/FibLib/Pandoc.fs +++ /dev/null @@ -1,38 +0,0 @@ -namespace Fibble.FibLib - -module Pandoc = - open System.Diagnostics - - let toHtml (from: string) (markdownText: string) = - let startInfo = ProcessStartInfo( - FileName = "pandoc", - Arguments = $"-f {from} -t html5 --lua-filter strip-p.lua", - RedirectStandardInput = true, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) - - try - use proc = Process.Start startInfo - // Skriv markdown till Pandoc - use stdin = proc.StandardInput - stdin.Write markdownText - stdin.Close() // Måste stängas så Pandoc vet att texten är slut - // Läs ut resultatet - let htmlOutput = proc.StandardOutput.ReadToEnd() - let errorOutput = proc.StandardError.ReadToEnd() - - proc.WaitForExit() - - if proc.ExitCode = 0 then - htmlOutput.Trim() - else - sprintf "\n
%s
and 
%s
" errorOutput markdownText - - with ex -> - // Fångar upp om Pandoc inte är installerat eller inte finns i PATH - sprintf "\n
%s
and 
%s
" ex.Message markdownText - - let mdToHtml markdownText = - toHtml "markdown" markdownText diff --git a/src/FibLib/strip-p.lua b/src/FibLib/strip-p.lua deleted file mode 100644 index 3d7d3d7..0000000 --- a/src/FibLib/strip-p.lua +++ /dev/null @@ -1,5 +0,0 @@ -function Pandoc(doc) - if #doc.blocks > 0 and doc.blocks[1].t == "Para" then - return pandoc.Pandoc(doc.blocks[1].content, doc.meta) - end -end diff --git a/src/Fibble/Program.fs b/src/Fibble/Program.fs index f92e40c..3824277 100644 --- a/src/Fibble/Program.fs +++ b/src/Fibble/Program.fs @@ -7,36 +7,41 @@ open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc. // ========================================== // makeElem returnerar nu en strukturerad Element-nod istället för en sträng -let elem (name : string) = - (name, fun meta args children -> Element(name, args, children)) +let makeElem (name : string) = + (name, fun args children -> Element(name, args, children)) let makeElems lst = - List.map elem lst + List.map makeElem lst +let defaultPrelude : Map = + [ "b"; "em"; "i"; "strong" ] + |> makeElems + |> Map.ofList -let myPrelude : Map = - Map [ - "quotient", fun _ args _ -> +let myPrelude : Map = + Map.ofList [ + "quotient", fun args _ -> if args.Length >= 2 then Text (sprintf "%d" (int args.[0] / int args.[1])) else Text "[Fel: quotient kräver två argument]" - "bold", fun _ args children -> + + "bold", fun args children -> Element("b", args, children) - "value", fun meta args _ -> - Text meta[args.Head] - "link", fun _ args children -> + + "link", fun args children -> let url = if args.Length > 0 then args.[0].Trim('"') else "#" + // Vi mappar argumenten till HTML-attribut (t.ex. href="...") Element("a", [sprintf "href=\"%s\"" url], children) - + // @br har varken argument eller barn, så vi returnerar bara rå HTML direkt - "br", fun _ _ _ -> RawHtml "
" - ] + "br", fun _ _ -> + RawHtml "
" + ] // ========================================== // 2. Mall och Evaluator // ========================================== - let pageTemplate = """ @@ -114,7 +119,7 @@ let increment () = Första anropet: @(increment()) Andra anropet: @(increment()) -Test av utskrift: @value[date] +Test av utskrift: " // ========================================== // 3. Huvudpipeline @@ -123,7 +128,7 @@ let processDocument (source: string) = let evaluator = Evaluators.FsiEvaluator() // Steg 1: Parsa koden - let metadata, rawBlocks = Parser.parse source + let (metadata, rawBlocks) = Parser.parse source // Hjälpfunktion: Gå igenom trädet och byt ut @value{...} mot faktiskt data från YAML let rec resolveMeta = function @@ -141,11 +146,11 @@ let processDocument (source: string) = | Paragraph children -> Paragraph (children |> List.map resolveMeta - |> List.map (Execution.transform metadata myPrelude evaluator)) + |> List.map (Execution.transform myPrelude evaluator)) | Section(l, a, children) -> Section(l, a, children |> List.map resolveMeta - |> List.map (Execution.transform metadata myPrelude evaluator)) + |> List.map (Execution.transform myPrelude evaluator)) ) // Steg 3: Be printern skriva ut trädet till HTML