diff --git a/Fibble.slnx b/Fibble.slnx deleted file mode 100644 index cbf8a5b..0000000 --- a/Fibble.slnx +++ /dev/null @@ -1,6 +0,0 @@ - - - - - - diff --git a/src/Bif/Bif.fsproj b/src/Bif/Bif.fsproj index fb0e0a5..8d26c7e 100644 --- a/src/Bif/Bif.fsproj +++ b/src/Bif/Bif.fsproj @@ -7,9 +7,6 @@ - - - diff --git a/src/Bif/Program.fs b/src/Bif/Program.fs index 2191e84..4f6aa83 100644 --- a/src/Bif/Program.fs +++ b/src/Bif/Program.fs @@ -1,59 +1,84 @@ -open System.IO +open System.Net +open System.IO +open System.Runtime.CompilerServices +open FSharp.Compiler.Text open Fibble.FibLib -open Fibble.FibLib.Ast +open Fibble.FibLib.Ast // Ger oss tillgång till Element, Text, RawHtml etc. +open Fibble.FibLib.Pandoc open Fibble.FibLib.HtmlPrinter +open Fibble.FibLib.Utils open Fibble.FibLib.ConstructionHelpers +// ========================================== +// 1. Prelude (Dina egna taggar) +// ========================================== -let myPrelude: Map = - Map - [ "quotient", - fun _ args _ _ -> - match args with - | [ one; two ] -> Inline(Text(sprintf "%d" (int one / int two))) - | _ -> Inline(Text "[Fel: quotient kräver två argument]") - "bold", fun _ _ _ children -> Inline(Strong(children)) - "kursiv", fun _ _ _ children -> Inline(Emph(children)) - "image", image - "value", value - "link", link - "list", - fun _ _ _ c -> - System.Console.WriteLine(c) - Inline(RawHtml "hej") - "br", linebreak - "table", table - "md", fun _ _ _ _ -> Inline(Text "hej") ] +let myPrelude : Map = + Map [ + "quotient", fun _ args _ _ -> + match args with + | [one; two] -> + Text (sprintf "%d" (int one / int two)) + | _ -> + Text "[Fel: quotient kräver två argument]" + "bold", fun _ _ _ children -> + Strong(children) + "kursiv", fun _ _ _ children -> Emph(children) + "image", image + "value", value + "link", link + "list", fun _ _ _ c -> System.Console.WriteLine(c) + RawHtml "hej" + + // @br har varken argument eller barn, så vi returnerar bara rå HTML direkt + "br", linebreak + "table", fun _ _ _ children -> Text "hej" + "md", fun _ _ _ children -> RawHtml (mdToHtml (stringifyNodes children)) + ] +// ========================================== +// 2. Mall och Evaluator +// ========================================== +// module File = let readFile path = match Path.Exists(path) with - | true -> File.ReadAllText(path) - | _ -> failwith $"{Path.GetFullPath path} does not exist" + | true -> File.ReadAllText(path) + | _ -> failwith $"{Path.GetFullPath path} does not exist" let pageTemplate = File.readFile "_page-template" let sourceCode = File.readFile "document.fib" - - +// ========================================== +// 3. Huvudpipeline +// ========================================== let processDocument (source: string) = - let evaluator = Evaluators.NullEvaluator() + let evaluator = Evaluators.FsiEvaluator() + + // Steg 1: Parsa koden + let metadata, rawBlocks = Parser.parse source + - // Parsa koden - let metadata, raewBlocks = Parser.parse source - let rawBlocks = AstUtils.slurpSections raewBlocks + // Steg 2: Transformera och exekvera trädet + let evaluatedBlocks = + rawBlocks |> List.map (function + | Paragraph children -> + Paragraph (children + |> List.map (Execution.transform metadata myPrelude evaluator)) + | Section(l, a, children) -> + Section(l, a, children + |> List.map (Execution.transform metadata myPrelude evaluator)) + | _ -> failwith "haha" + + ) - - let evaluatedBlocks = - CommandEvaluator.evaluateDocument metadata myPrelude evaluator rawBlocks - - // Be printern skriva ut trädet till HTML - let bodyHtml = HtmlWriter.renderDocument evaluatedBlocks + // Steg 3: Be printern skriva ut trädet till HTML + let bodyHtml = HtmlPrinter.render evaluatedBlocks // Steg 4: Fyll i din HTML-mall let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml) - + finalHtml // Kör programmet diff --git a/src/Bif/_page-template b/src/Bif/_page-template deleted file mode 100644 index 121840b..0000000 --- a/src/Bif/_page-template +++ /dev/null @@ -1,53 +0,0 @@ - - - - - - - - {{title}} - - - - - -× - -
- -

{{title}}

-
- by {{author}} - {{date}} -
- -
-{{body}} - - -
- - -
- - diff --git a/src/Bif/document.fib b/src/Bif/document.fib index 75d9edf..9bd2254 100644 --- a/src/Bif/document.fib +++ b/src/Bif/document.fib @@ -6,10 +6,44 @@ title: FSI Test @section{Definitioner} Vi definierar en funktion och en variabel. +@""" +let globalCounter = ref 0 -@table{ -rubrik 1 | rubrik 2 -1 | 3 -2 | 4 +let increment () = + globalCounter.Value <- globalCounter.Value + 1 + sprintf "Räknaren är nu %d" globalCounter.Value +""" +@(1) + +@link[www.google.com]{hejsan hoppsan fallerallera} + +Detta är en paragraf som har lite text i sig och lite @md{inbäddad *markdown* som kanske} funkar. Det är bra så. + +@md{ +babeuoastnuhaoesn + +hej hopp +--- ---- +abc defg +bde dddd +ueo eoau +ueo aoeu } +elleR? + +@list{ +Första saken +Andra saken med @bold{text} +Tredje saken +} + +@section{Användning} +Första anropet: @(increment()) +Andra anropet: @(increment()) + +@bold{detta är ibdenrerat. + detta också. + hej} + +Test av utskrift: @value[date] diff --git a/src/FibLib/AstUtils.fs b/src/FibLib/AstUtils.fs deleted file mode 100644 index b4a0423..0000000 --- a/src/FibLib/AstUtils.fs +++ /dev/null @@ -1,115 +0,0 @@ -namespace Fibble.FibLib - -module AstUtils = - open Ast - // Hjälpfunktion som samlar block rekursivt - let rec private gatherBlocks (currentLevel: int) (nodes: BlockNode list) : BlockNode list * BlockNode list = - match nodes with - | [] -> [], [] - - // Byt namn till 'existingBlocks' för tydlighet - | Section(attr, lvl, title, existingBlocks) :: tail when lvl > currentLevel -> - - // 1. Samla in de Nya blocken som tillhör undersektionen från tail - let gatheredBlocks, restAfterSub = gatherBlocks lvl tail - - // SÄKERHETSFIX: Slå ihop de gamla och de nya blocken! - let combinedBlocks = existingBlocks @ gatheredBlocks - let newSection = Section(attr, lvl, title, combinedBlocks) - - // 2. Fortsätt samla in syskon till denna undersektion - let siblingBlocks, remaining = gatherBlocks currentLevel restAfterSub - newSection :: siblingBlocks, remaining - - // Vi hittar en sektion på samma eller "högre" nivå - | Section(_, lvl, _, _) :: _ when lvl <= currentLevel -> [], nodes - - // Vanliga block (Paragraph, Table, etc.) - | block :: tail -> - let siblingBlocks, remaining = gatherBlocks currentLevel tail - block :: siblingBlocks, remaining - - - let slurpSections ast = - let nestedAst, _ = gatherBlocks 0 ast - nestedAst - - let splitByNewlines (nodes: InlineNode list) = - // Folder-funktionen håller koll på: (Pågående rad, Lista med färdiga rader) - let folder (currentLine, completedLines) node = - match node with - | Text t -> - // Splitta texten. Vi tar bort \r för att stödja både Windows och Mac/Linux. - let lines = t.Replace("\r", "").Split('\n') |> Array.toList - - match lines with - | [] -> (currentLine, completedLines) // Händer aldrig med Split - | [ single ] -> - // Ingen radbrytning hittades, fortsätt bygga på nuvarande rad - (Text single :: currentLine, completedLines) - | first :: rest -> - // Vi hittade minst en radbrytning! - // 1. Avsluta den pågående raden med första delen av texten - let finishedFirstLine = List.rev (Text first :: currentLine) - - // 2. Den sista biten text blir början på nästa rad - let lastPart = rest |> List.last - - // 3. Allt i mitten är egna fristående rader - let middleLines = - rest |> List.take (rest.Length - 1) |> List.map (fun s -> [ Text s ]) - - // Skicka tillbaka (Ny pågående rad, Uppdaterad lista med färdiga rader) - ([ Text lastPart ], completedLines @ [ finishedFirstLine ] @ middleLines) - - | otherNode -> - // Är det t.ex. ett Command lägger vi bara till det på pågående rad - (otherNode :: currentLine, completedLines) - - // Kör foldern över alla noder - let finalLine, allCompletedLines = List.fold folder ([], []) nodes - let allLinesRaw = allCompletedLines @ [ List.rev finalLine ] - - // --- STÄDNING --- - // Ta bort tomma text-noder (skräp från splitten) och kasta helt tomma rader - allLinesRaw - |> List.map ( - List.choose (function - | Text t when System.String.IsNullOrWhiteSpace(t) -> None - | validNode -> Some validNode) - ) - |> List.filter (not << List.isEmpty) - - - - let splitByPipe (nodes: InlineNode list) = - let folder (currentCell, completedCells) node = - match node with - | Text t -> - // Klyv på rör-tecknet istället - let parts = t.Split('|') |> Array.toList - - match parts with - | [] -> (currentCell, completedCells) - | [ single ] -> (Text single :: currentCell, completedCells) - | first :: rest -> - let finishedFirstCell = List.rev (Text first :: currentCell) - let lastPart = rest |> List.last - - let middleCells = - rest |> List.take (rest.Length - 1) |> List.map (fun s -> [ Text s ]) - - ([ Text lastPart ], completedCells @ [ finishedFirstCell ] @ middleCells) - - | otherNode -> (otherNode :: currentCell, completedCells) - - let finalCell, allCompletedCells = List.fold folder ([], []) nodes - let allCellsRaw = allCompletedCells @ [ List.rev finalCell ] - - // Städa bort helt tomma text-noder som uppstår vid klyvningen - allCellsRaw - |> List.map ( - List.choose (function - | Text t when System.String.IsNullOrWhiteSpace(t) -> None - | validNode -> Some validNode) - ) diff --git a/src/FibLib/FibLib.fsproj b/src/FibLib/FibLib.fsproj index 91b09b4..2765919 100644 --- a/src/FibLib/FibLib.fsproj +++ b/src/FibLib/FibLib.fsproj @@ -8,7 +8,6 @@ - diff --git a/src/FibLib/HtmlPrinter.fs b/src/FibLib/HtmlPrinter.fs index c66ca56..17c607d 100644 --- a/src/FibLib/HtmlPrinter.fs +++ b/src/FibLib/HtmlPrinter.fs @@ -4,151 +4,60 @@ module Fibble.FibLib.HtmlPrinter open System.Net -module HtmlWriter = +module HtmlPrinter = open Ast - - // --- HJÄLPARFUNKTIONER --- - - let escapeHtml (text: string) = - if System.String.IsNullOrEmpty(text) then - "" - else - WebUtility.HtmlEncode(text) - - // Plockar ut ren text för attribut som alt-texter där vi inte får ha HTML-taggar - let rec extractText (nodes: InlineNode list) = - nodes - |> List.map (function - | Text t -> t - | RawHtml h -> h - | Emph c - | Underline c - | Strong c - | Strikeout c - | Superscript c - | Subscript c -> extractText c - | Link(_, (_, c)) -> extractText c - | Code(_, t) -> t - | _ -> "") - |> String.concat "" - - // Bygger attributsträngen: id="X" class="Y Z" key="value" - let renderAttr (attr: Attr) = - let idStr = - if System.String.IsNullOrWhiteSpace(attr.id) then - "" - else - sprintf " id=\"%s\"" attr.id - - let classStr = - match attr.classes with - | [] -> "" - | classes -> sprintf " class=\"%s\"" (String.concat " " classes) - - let kvpStr = - match attr.kvp with - | [] -> "" - | kvps -> - let pairs = kvps |> List.map (fun (k, v) -> sprintf "%s=\"%s\"" k v) - " " + (String.concat " " pairs) - - idStr + classStr + kvpStr - - - - // --- HUVUDRENDERARE --- - - let rec renderDocument (blocks: BlockNode list) = - blocks |> List.map renderBlock |> String.concat "" - - // Renderar Block-noder - and renderBlock = + open System.Net + let renderAttributes (args: (string * string) list) = + args + |> List.map (fun k -> sprintf "%s=\"%s\"" (fst k) (snd k)) + |> String.concat " " + let rec renderInline = + let renderAll l = + l + |> List.map renderInline + |> String.concat "" function - | Paragraph children -> sprintf "

%s

\n" (renderInlines children) + | Text t -> WebUtility.HtmlEncode t + | Strong(t) -> sprintf "%s" (renderAll t) + | RawHtml h -> + h + | _ -> "" + + let renderFigure a c l = + failwith "haha" + + let renderListItem item = + sprintf "
  • %s
  • " item + + let renderList kind attributes nodesList = + let content = nodesList + |> List.map renderListItem + |> String.concat "\n" + $"<{kind} {(renderAttributes attributes)}>{content}" + - | Plain inlines -> sprintf "%s\n" (renderInlines inlines) - - | CodeBlock(attr, text) -> sprintf "
    %s
    \n" (renderAttr attr) (escapeHtml text) - - | Figure(attr, caption, blocks) -> - let bodyHtml = blocks |> List.map renderBlock |> String.concat "" - let captionHtml = renderInlines caption - sprintf "\n%s
    %s
    \n\n" (renderAttr attr) bodyHtml captionHtml - - | Section(attr, lvl, title, body) -> - // Begränsa h-nivåer till h1-h6 för giltig HTML - let hLvl = max 1 (min 6 lvl) - let titleHtml = renderInlines title - let bodyHtml = body |> List.map renderBlock |> String.concat "" - sprintf "\n%s\n%s\n" (renderAttr attr) hLvl titleHtml hLvl bodyHtml - - | ListBlock kind -> - match kind with - | Orderedlist(attr, start, blocksList) -> - let startAttr = if start <> 1 then sprintf " start=\"%d\"" start else "" - - let itemsHtml = - blocksList - |> List.map (fun b -> sprintf "
  • %s
  • \n" (b |> List.map renderBlock |> String.concat "")) - |> String.concat "" - - sprintf "\n%s\n" (renderAttr attr) startAttr itemsHtml - - | BulletList(attr, blocksList) -> - let itemsHtml = - blocksList - |> List.map (fun b -> sprintf "
  • %s
  • \n" (b |> List.map renderBlock |> String.concat "")) - |> String.concat "" - - sprintf "\n%s\n" (renderAttr attr) itemsHtml - | Table(attr, rows) -> - let renderedRows = List.map renderRow rows |> String.concat " " - sprintf "%s" (renderAttr attr) renderedRows - - // Renderar en lista av Inline-noder - and renderInlines inlines = - inlines |> List.map renderInline |> String.concat "" - - // Renderar enskilda Inline-noder - and renderInline = - function - | Text t -> escapeHtml t - | RawHtml h -> h - - // Formatering - | Emph c -> sprintf "%s" (renderInlines c) - | Strong c -> sprintf "%s" (renderInlines c) - | Underline c -> sprintf "%s" (renderInlines c) - | Strikeout c -> sprintf "%s" (renderInlines c) - | Superscript c -> sprintf "%s" (renderInlines c) - | Subscript c -> sprintf "%s" (renderInlines c) - - // Länkar och bilder - | Link(attr, (url, content)) -> sprintf "%s" url (renderAttr attr) (renderInlines content) - - | Image(attr, altText, url) -> - // Bild-alt måste vara ren text (får ej innehålla , etc) - let cleanAlt = extractText altText |> escapeHtml - sprintf "\"%s\"%s" url cleanAlt (renderAttr attr) - - | Code(attr, text) -> sprintf "%s" (renderAttr attr) (escapeHtml text) - - | SoftBreak -> "\n" - | LineBreak -> "
    " - - | Expr(_, resultOpt) -> resultOpt |> Option.defaultValue "" - - | Note _ -> - // Fotnoter renderas oftast som en ankarlänk här, och själva innehållet längst ner på sidan. - // (Detta kan vi implementera senare när du bygger det globala state-systemet) - "[ref]" - - | Command(tag, _, _, _) -> - // Denna nod borde inte existera längre om Evaluatorn har gjort sitt jobb - failwithf "Kritiskt fel: Oexpanderat makro '@%s' nådde HTML-renderaren!" tag - - and renderRow (Row cells) = - let renderedCell (Cell children) = - sprintf "%s" (renderInlines children) - - List.map renderedCell cells |> String.concat "" |> sprintf "%s\n" + let rec render blocks = + let doubleRender blocksblock = + List.map render blocksblock + + let renderNode = function + | Paragraph [RawHtml html] -> + html + | 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 + | CodeBlock(attributes, text) -> sprintf "%s" text + | Figure(attributes, caption, blocks) -> renderFigure attributes caption blocks + | ListBlock(l) -> match l with + | BulletList(attr, blocknodes) -> renderList "ul" attr.kvp (doubleRender blocknodes) + | Orderedlist(attr, start, blocknodes) -> renderList "ol" attr.kvp (doubleRender blocknodes) + | Plain nodes -> List.map renderInline nodes |> String.concat " " + blocks + |> List.map renderNode + |> String.concat "\n" diff --git a/src/FibLib/Library.fs b/src/FibLib/Library.fs index e6f12ff..87fa452 100644 --- a/src/FibLib/Library.fs +++ b/src/FibLib/Library.fs @@ -1,7 +1,6 @@ namespace Fibble.FibLib - -open System +open System.Net open FParsec open YamlDotNet.Serialization open System.Collections.Generic @@ -11,13 +10,10 @@ open System.Collections.Generic // 1. AST & Utils // ========================================== module Ast = - - type Attr = - { id: string - classes: string list - kvp: (string * string) list } - - + + type Attr = { id: string; classes: string list; kvp: (string * string) list } + + type InlineNode = | Text of string | RawHtml of string @@ -35,149 +31,114 @@ module Ast = | 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 + | 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 = + | 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 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 - + type TagRenderer = Map + -> string list + -> Map + -> 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 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 + let minIndent = + if lines.Length <= 1 then 0 else - lines - |> Array.skip 1 + 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 + |> 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 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 + let t2 = + if isFirstText then isFirstText <- false t1.TrimStart(' ', '\t') - else - t1 - + 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) + | otherNode -> otherNode + ) // 3. Städa bort överflödiga radbrytningar och blanksteg i ytterkanterna - let rec trimStart = - function - | Text t :: rest -> + let rec trimStart = function + | Text t :: rest -> let trimmed = t.TrimStart('\n', '\r', ' ', '\t') - - if trimmed = "" then - trimStart rest - else - Text trimmed :: rest + if trimmed = "" then trimStart rest else Text trimmed :: rest | other -> other - - let rec trimEnd = - function - | Text t :: rest -> + + 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 = + 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 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 + 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('"') + | 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) - = + 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 @@ -189,247 +150,183 @@ module Utils = module Parser = open Ast - let pseudoRandom = new System.Random() - let pInline, pInlineRef = createParserForwardedToRef () + 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 + 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 - ) + attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_") + .>> spaces .>> pchar '=' .>> spaces) .>>. manyChars (noneOf ",]") - |>> fun (k, v) -> k, v.Trim() + |>> fun (k, v) -> (k, v.Trim()) let pPositionalArg = // Bara "värde" - manyChars (noneOf ",]") |>> fun v -> "", v.Trim() + manyChars (noneOf ",]") |>> fun v -> ("", v.Trim()) let pSingleArg = spaces >>. (pNamedArg <|> pPositionalArg) .>> spaces - let pArgs = + let pArgs = between (pstring "[") (pstring "]") (sepBy pSingleArg (pchar ',')) >>= fun args -> // Validera att positionella argument alltid kommer först - let rec validate canBePositional = - function + let rec validate canBePositional = function | [] -> preturn args // Allt är okej, returnera listan - | ("", _) :: tail -> - if not canBePositional then + | ("", _) :: tail -> + if not canBePositional then fail "Syntaxfel: Positionella argument får inte komma efter namngivna argument." - else - validate true tail - | _ :: tail -> validate false tail - + else validate true tail + | _ :: tail -> + validate false tail + validate true args - - let pBody, pBodyRef = createParserForwardedToRef () + // --- 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() // --- 2. Parentes-parser (för @(...) med sträng-stöd) --- - let pParenBody, pParenBodyRef = createParserForwardedToRef () + 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)" ] - ) + pParenBodyRef.Value <- + manyStrings (choice [ + pFSharpString + many1Chars (noneOf "()\"") + pchar '(' >>. pParenBody .>> pchar ')' |>> sprintf "(%s)" + ]) - let pExpr = - attempt (pstring "@(") >>. pParenBody .>> pstring ")" |>> fun c -> Expr(c, None) + 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) - let pInlineCommand = - attempt (pchar '@' >>. many1Chars asciiLetter) .>>. opt pArgs .>>. opt pBody - |>> fun ((name, argsOpt), bodyOpt) -> + // 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, kwargs = separateArgs rawArgs - // dedentNodes fixes indentation of inline commands spanning several lines + 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) - 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) - - + // Nu när pInlineCommand, pExpr och pMultilineCode är definierade + // kan vi skapa pInnerInline let pInnerInline = - choice - [ pAtCommand // Hanterar alla @-baserade noder - many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt + choice [ + attempt pInlineCommand + attempt pExpr + pMultilineCode + many1Chars (noneOf "@}") |>> Text + pchar '@' |>> fun _ -> Text "@" + ] + // Tilldela värdet till pBodyRef pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline) - pInlineRef.Value <- - choice - [ pAtCommand - many1Chars (noneOf "@{}\n\r") |>> Text - attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ] + // 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 = - - 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 + 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, []) + Section(getSectionLevel name, defaultArg argsOpt [], defaultArg bodyOpt []) let pParagraphBlock = many1 pInline |>> Paragraph - let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ] + let pBlock = choice [ pSectionBlock; pParagraphBlock ] - let pDocument = - spaces + // --- Dokument Parser --- + let pDocument = + spaces >>. opt ( - pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---")) - |>> fun yamlStr -> + 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 + 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) + |>> fun (headerOpt, blocks) -> + (defaultArg headerOpt Map.empty, blocks) - let parse i = - match run pDocument i with - | Success(r, _, _) -> r + let parse i = + match run pDocument i with + | Success(r, _, _) -> r | Failure(e, _, _) -> failwith e -[] -type IEvaluator() = +// ========================================== +// 3. Execution & Printer +// ========================================== +type IEvaluator = abstract member Evaluate: string -> string - abstract member NewSession: unit -> unit + +module Execution = + open Ast + + let rec transform (metadata: Map) (prelude: Map) (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 NullEvaluator() = - inherit IEvaluator() - override this.Evaluate(code: string) = "" - override this.NewSession() = () - - - type FsiEvaluator() = - inherit IEvaluator() let sbOut = StringBuilder() - let sbErr = StringBuilder() + let sbErr = StringBuilder() let inStream = new StringReader("") let outStream = new StringWriter(sbOut) let errStream = new StringWriter(sbErr) @@ -437,180 +334,62 @@ module Evaluators = // Initiera FSI-sessionen let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration() let argv = [| "fsi.exe"; "--noninteractive" |] + let session = FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream) - let session = - FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream) + interface IEvaluator with + member _.Evaluate(code: string) = + sbOut.Clear() |> ignore + sbErr.Clear() |> ignore - override this.Evaluate(code: string) = - sbOut.Clear() |> ignore - sbErr.Clear() |> ignore + try + let result, _warnings = session.EvalInteractionNonThrowing(code) - try - let result, _warnings = session.EvalInteractionNonThrowing(code) + let output = sbOut.ToString() + let errors = sbErr.ToString().Trim() - 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() - // 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 - "" + 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 - match fsiValue.ReflectionValue with - | :? string as s -> s - | v -> sprintf "%A" v + 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 - 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 + diff --git a/src/FibLib/Pandoc.fs b/src/FibLib/Pandoc.fs index f85d610..0df9736 100644 --- a/src/FibLib/Pandoc.fs +++ b/src/FibLib/Pandoc.fs @@ -7,16 +7,14 @@ 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 - ) + 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 @@ -27,21 +25,20 @@ module Pandoc = // Läs ut resultatet let htmlOutput = proc.StandardOutput.ReadToEnd() let errorOutput = proc.StandardError.ReadToEnd() - - - + + + proc.WaitForExit() Console.WriteLine(htmlOutput) - 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 = - let res = toHtml "markdown" markdownText + let res= toHtml "markdown" markdownText res diff --git a/src/FibLib/constructorHelpers.fs b/src/FibLib/constructorHelpers.fs index 5c484e4..2b57d06 100644 --- a/src/FibLib/constructorHelpers.fs +++ b/src/FibLib/constructorHelpers.fs @@ -1,50 +1,28 @@ namespace Fibble.FibLib +open FSharp.Compiler.Text open Fibble.FibLib.Ast module Helpers = - let emptyAttr = { id = ""; classes = []; kvp = [] } - - let ah cls kvp = - { id = "" - classes = [ cls ] - kvp = Map.toList kvp } - + let emptyAttr ={id=""; classes=[]; kvp=[]} + let ah cls kvp = + {id=""; classes = [cls]; kvp = Map.toList kvp } let onlyChildren constructor : TagRenderer = - fun _ _ _ children -> Inline(constructor (children)) - - let makeAttr kwargs = - let id = defaultArg (Map.tryFind "id" kwargs) "" - - let classes = - match Map.tryFind "class" kwargs with - | Some v -> v.Split "," |> Array.toList - | None -> [] - - let rest = - Map.toList kwargs - |> List.filter (fun p -> not (List.contains (fst p) [ "id"; "class" ])) - - { id = id - classes = classes - kvp = rest } - - - + fun _ _ _ children -> constructor(children) open Helpers module ConstructionHelpers = - let linebreak _ _ _ _ = Inline(LineBreak) - let softbreak _ _ _ _ = Inline(SoftBreak) - - let value: TagRenderer = + let linebreak _ _ _ _ = LineBreak + let softbreak _ _ _ _ = SoftBreak + + let value : TagRenderer = fun meta args _ _ -> match Map.tryFind args.Head meta with - | Some v -> Inline(Text v) - | None -> Inline(Text $"value {args.Head} not found in metadata") - - + | Some(v) -> Text v + | None -> Text $"value {args.Head} not found in metadata" + + let emph = onlyChildren Emph let underline = onlyChildren Underline let strong = onlyChildren Strong @@ -52,39 +30,24 @@ module ConstructionHelpers = let superscript = onlyChildren Superscript let subscript = onlyChildren Subscript - let image: TagRenderer = + let image : TagRenderer = fun _ args kwargs children -> let attributes = ah "inlineImage" kwargs - Inline(Image(attributes, children, args[0])) - - let code: TagRenderer = + Image(attributes,children, args[0]) + let code : TagRenderer = fun _ _ kwargs children -> let attributes = ah "inlineCode" kwargs - match children with - | [ Text(c) ] -> Inline(InlineNode.Code(attributes, c)) - | _ -> failwith "Code tag was not Text," - - let link: TagRenderer = + | [Text(c)] -> InlineNode.Code(attributes, c) + | _ -> failwith "Code tag was not Text," + + let link : TagRenderer = fun _ args kwargs children -> let attributes = ah "link" kwargs - Inline(Link(attributes, Target(args[0], children))) - - + Link(attributes,Target(args[0], children)) + + // blocks let paragraph _ _ _ children = Paragraph(children) let plain _ _ _ children = Plain(children) - - let table _ args kwargs children = - let rows = - children - |> AstUtils.splitByNewlines - |> List.map (fun rowNodes -> - - let cells = rowNodes |> AstUtils.splitByPipe |> List.map Cell // Wrap each split list in a Cell node - - Row cells) - - let attr = makeAttr kwargs - Block(Table(attr, rows))