Compare commits

...

2 commits

Author SHA1 Message Date
8402ff3a3c amessage 2026-03-31 15:22:16 +02:00
f971423f04 hejsan hoppsan 2026-03-31 13:36:22 +02:00
9 changed files with 312 additions and 145 deletions

View file

@ -13,4 +13,8 @@
<ProjectReference Include="..\FibLib\FibLib.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Update="FSharp.Core" Version="10.1.201" />
</ItemGroup>
</Project>

View file

@ -1,9 +1,13 @@
open System.Net
open System.IO
open System.Runtime.CompilerServices
open FSharp.Compiler.Text
open Fibble.FibLib
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)
@ -12,27 +16,25 @@ open Fibble.FibLib.Utils
let myPrelude : Map<string, TagRenderer> =
Map [
"quotient", fun _ args _ ->
"quotient", fun _ args _ _ ->
match args with
| [_, one; _, two] ->
| [one; two] ->
Text (sprintf "%d" (int one / int two))
| _ ->
Text "[Fel: quotient kräver två argument]"
"bold", fun _ args children ->
Element("b", args, children)
"image", positional (fun _ args _ -> Element("img", [("src", args[0])], []))
"value", positional (fun meta args _ ->
match Map.tryFind args.Head meta with
| Some(v) -> Text v
| None -> Text $"value {args.Head} not found in metadata")
"link", positional (fun _ args children ->
let url = if args.Length > 0 then args.[0].Trim '"' else "#"
Element("a", [("href", args.Head)], children))
"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, vi returnerar bara HTML direkt
"br", nameToElement "br"
"table", fun _ _ children -> Text "hej"
"md", fun meta args children -> RawHtml (mdToHtml (stringifyNodes children))
"br", linebreak
"table", fun _ _ _ children -> Text "hej"
"md", fun _ _ _ children -> RawHtml (mdToHtml (stringifyNodes children))
]
// ==========================================
@ -43,7 +45,7 @@ module File =
let readFile path =
match Path.Exists(path) with
| true -> File.ReadAllText(path)
| _ -> failwith $"{path} does not exist"
| _ -> failwith $"{Path.GetFullPath path} does not exist"
let pageTemplate = File.readFile "_page-template"
@ -67,10 +69,12 @@ let processDocument (source: string) =
| Section(l, a, children) ->
Section(l, a, children
|> List.map (Execution.transform metadata myPrelude evaluator))
| _ -> failwith "haha"
)
// Steg 3: Be printern skriva ut trädet till HTML
let bodyHtml = HtmlPrinter.render (metadata, evaluatedBlocks)
let bodyHtml = HtmlPrinter.render evaluatedBlocks
// Steg 4: Fyll i din HTML-mall
let mutable finalHtml = pageTemplate.Replace("{{body}}", bodyHtml)

View file

@ -20,7 +20,7 @@ let increment () =
Detta är en paragraf som har lite text i sig och lite @md{inbäddad *markdown* som kanske} funkar. Det är bra så.
@md{
en tabell
babeuoastnuhaoesn
hej hopp
--- ----
@ -32,8 +32,18 @@ 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]

View file

@ -8,12 +8,15 @@
<ItemGroup>
<Compile Include="Pandoc.fs" />
<Compile Include="Library.fs" />
<Compile Include="constructorHelpers.fs" />
<Compile Include="HtmlPrinter.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FParsec" Version="1.1.1" />
<PackageReference Include="FSharp.Compiler.Service" Version="43.12.201" />
<PackageReference Include="YamlDotNet" Version="16.3.0" />
<PackageReference Update="FSharp.Core" Version="10.1.201" />
</ItemGroup>
</Project>

59
src/FibLib/HtmlPrinter.fs Normal file
View file

@ -0,0 +1,59 @@
// ReSharper disable FSharpInterpolatedString
module Fibble.FibLib.HtmlPrinter
open System.Net
module HtmlPrinter =
open Ast
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 =
function
| Text t -> WebUtility.HtmlEncode t
| Strong(t) -> sprintf "<strong>%s</strong>" (renderInline t)
| RawHtml h ->
h
| _ -> ""
let renderFigure a c l =
failwith "haha"
let renderListItem item =
sprintf "<li>%s</li>" item
let renderList kind attributes nodesList =
let content = nodesList
|> List.map renderListItem
|> String.concat "\n"
$"<{kind} {(renderAttributes attributes)}>{content}</{kind}>"
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 "<p>%s</p>" (c |> List.map renderInline |> String.concat "")
| Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l
| CodeBlock(attributes, text) -> sprintf "<code>%s</code>" 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"

View file

@ -10,32 +10,55 @@ 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
| Element of tag: string * args: (string * string) list * children: InlineNode list
type BlockNode =
| Section of level: int * args: (string * string) list * children: InlineNode list
| 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 * string) list -> InlineNode list -> InlineNode
type TagRenderer = Map<string,string>
-> string list
-> Map<string,string>
-> 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</%s>" tag attrs (stringifyNodes children) tag
| Expr(_, Some res) -> res
| Expr(code, None) -> sprintf "@(%s)" code // Fallback om den inte evaluerats
| _ -> failwith "haha"
)
|> String.concat ""
@ -43,32 +66,63 @@ module Ast =
module Utils =
open Ast
let smartDedent (input: string) =
let lines = input.Replace("\r\n", "\n").Split '\n' |> List.ofArray
let dedentNodes (nodes: InlineNode list) =
let fullText =
nodes |> List.choose (function Text t -> Some t | _ -> None) |> String.concat ""
// 1. Hitta den minsta indenteringen bland alla rader som har text
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 =
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
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
// 2. Dra av exakt många mellanslag från alla rader
// för att dessa inte ska vara med i det slutgiltiga dokumentet.
let mutable isFirstText = true
let indentStr = "\n" + String.replicate minIndent " "
// 2. Applicera formateringen
let dedented =
lines
|> List.map (fun l ->
if System.String.IsNullOrWhiteSpace(l) then ""
else l.Substring(minIndent)
nodes |> List.map (function
| Text t ->
let t1 = t.Replace("\r\n", "\n")
// Ta bort inledande mellanslag 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. Slå ihop och städa bort överflödiga radbrytningar i början/slutet
(String.concat "\n" dedented).Trim('\n', '\r')
// 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 meta (args: (string*string) list) children -> f meta (List.map snd args) children
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 = "")
@ -87,10 +141,6 @@ module Utils =
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)
@ -112,52 +162,49 @@ module Parser =
let isSection (name: string) = name.EndsWith("section")
let pNewline = newline
let pArg =
spaces >>.
choice [
let pNamedArg =
// Leta efter "nyckel=värde"
attempt (many1Chars (asciiLetter <|> digit <|> anyOf "-_")
.>> spaces .>> pchar '=' .>> spaces
.>>. manyChars (noneOf ",]"))
.>> spaces .>> pchar '=' .>> spaces)
.>>. manyChars (noneOf ",]")
|>> fun (k, v) -> (k, v.Trim())
// Fallback: bara "värde" (ges en tom nyckel)
let pPositionalArg =
// Bara "värde"
manyChars (noneOf ",]") |>> fun v -> ("", v.Trim())
] .>> spaces
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
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) ---
let pRawBody, pRawBodyRef = createParserForwardedToRef<string, unit>()
pRawBodyRef.Value <-
many (choice [
many1Chars (noneOf "{}")
pchar '{' >>. pRawBodyRef.Value .>> pchar '}' |>> sprintf "{%s}"
]) |>> String.concat ""
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
| Success(n, _, _) -> preturn n
| Failure(m, _, _) -> fail m
// 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>()
// 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
@ -172,19 +219,38 @@ module Parser =
// --- Övriga inline-parsers ---
let pMultilineCode =
pstring "@\"\"\"" >>. manyCharsTill anyChar (pstring "\"\"\"")
|>> fun c -> Expr(Utils.smartDedent c, None)
|>> fun c -> Expr(c, None)
// pInlineCommand använder nu forward-referensen pBodyRef
let pInlineCommand =
attempt (
pchar '@' >>. many1Chars asciiLetter >>= fun name ->
if isSection name then fail "Sektioner är block-element."
else preturn name
)
attempt (pchar '@' >>. many1Chars asciiLetter)
.>>. opt pArgs
.>>. opt pBody
|>> fun ((n, a), b) -> Element(n, defaultArg a [], defaultArg b [])
|>> 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
// MÅSTE tilldelas efter att alla pExpr, pInlineCommand etc. är definierade
// 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
@ -244,47 +310,13 @@ module Execution =
open Ast
let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (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))
| 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 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</%s>" t (renderAttributes a) (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 "<p>%s</p>" (c |> List.map renderInline |> String.concat "")
| Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l)
|> String.concat "\n"
module Evaluators =
@ -293,8 +325,8 @@ module Evaluators =
open FSharp.Compiler.Interactive.Shell
type FsiEvaluator() =
let sbOut = new StringBuilder()
let sbErr = new StringBuilder()
let sbOut = StringBuilder()
let sbErr = StringBuilder()
let inStream = new StringReader("")
let outStream = new StringWriter(sbOut)
let errStream = new StringWriter(sbErr)

View file

@ -1,5 +1,8 @@
namespace Fibble.FibLib
open System
open System.Xml.Schema
module Pandoc =
open System.Diagnostics
@ -17,14 +20,16 @@ module Pandoc =
use proc = Process.Start startInfo
// Skriv markdown till Pandoc
use stdin = proc.StandardInput
stdin.Write markdownText
stdin.WriteLine markdownText
stdin.Close() // Måste stängas Pandoc vet att texten är slut
// Läs ut resultatet
let htmlOutput = proc.StandardOutput.ReadToEnd()
let errorOutput = proc.StandardError.ReadToEnd()
proc.WaitForExit()
proc.WaitForExit()
Console.WriteLine(htmlOutput)
if proc.ExitCode = 0 then
htmlOutput.Trim()
else
@ -35,4 +40,5 @@ module Pandoc =
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText
let mdToHtml markdownText =
toHtml "markdown" markdownText
let res= toHtml "markdown" markdownText
res

View file

@ -0,0 +1,53 @@
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 onlyChildren constructor : TagRenderer =
fun _ _ _ children -> constructor(children)
open Helpers
module ConstructionHelpers =
let linebreak _ _ _ _ = LineBreak
let softbreak _ _ _ _ = SoftBreak
let value : TagRenderer =
fun meta args _ _ ->
match Map.tryFind args.Head meta with
| 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
let strikeout = onlyChildren Strikeout
let superscript = onlyChildren Superscript
let subscript = onlyChildren Subscript
let image : TagRenderer =
fun _ args kwargs children ->
let attributes = ah "inlineImage" kwargs
Image(attributes,children, args[0])
let code : TagRenderer =
fun _ _ kwargs children ->
let attributes = ah "inlineCode" kwargs
match children with
| [Text(c)] -> InlineNode.Code(attributes, c)
| _ -> failwith "Code tag was not Text,"
let link : TagRenderer =
fun _ args kwargs children ->
let attributes = ah "link" kwargs
Link(attributes,Target(args[0], children))
// blocks
let paragraph _ _ _ children = Paragraph(children)
let plain _ _ _ children = Plain(children)

View file

@ -127,10 +127,6 @@ let processDocument (source: string) =
// Hjälpfunktion: igenom trädet och byt ut @value{...} mot faktiskt data från YAML
let rec resolveMeta = function
| MetaRef key ->
match metadata.TryFind key with
| Some v -> Text v
| None -> Text (sprintf "[Saknad meta: %s]" key)
| Element(tag, args, children) ->
Element(tag, args, children |> List.map resolveMeta)
| other -> other