playing with the interface

This commit is contained in:
Linus Björnstam 2026-03-28 14:20:34 +01:00
parent 14697b3dd9
commit 6b952bd6fd
4 changed files with 141 additions and 23 deletions

View file

@ -6,13 +6,13 @@
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Pandoc.fs" />
<Compile Include="Library.fs" /> <Compile Include="Library.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FParsec" Version="1.1.1" /> <PackageReference Include="FParsec" Version="1.1.1" />
<PackageReference Include="FSharp.Compiler.Service" Version="43.12.201" /> <PackageReference Include="FSharp.Compiler.Service" Version="43.12.201" />
<PackageReference Include="System.Text.Json" Version="10.0.5" />
<PackageReference Include="YamlDotNet" Version="16.3.0" /> <PackageReference Include="YamlDotNet" Version="16.3.0" />
</ItemGroup> </ItemGroup>

View file

@ -6,7 +6,43 @@ open YamlDotNet.Serialization
open System.Collections.Generic 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> -> (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</%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 = module Utils =
open Ast
let smartDedent (input: string) = 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
@ -30,26 +66,30 @@ module Utils =
// 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet // 3. Slå ihop och städa bort överflödiga radbrytningar i början/slutet
(String.concat "\n" dedented).Trim('\n', '\r') (String.concat "\n" dedented).Trim('\n', '\r')
// ========================================== let positional f: TagRenderer =
// 1. AST & Utils fun meta (args: (string*string) list) children -> f meta (List.map snd args) children
// ==========================================
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 = let getArgIdx (args: (string*string) list) index defaultVal =
| Section of level: int * args: string list * children: InlineNode list let unnamed = args |> List.filter (fun (k, _) -> k = "")
| Paragraph of children: InlineNode list if index < unnamed.Length then (snd unnamed.[index]).Trim('"')
else defaultVal
type Document = BlockNode list // 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
type TagRenderer = Map<string,string> -> string list -> 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
let nameToElement (n:string) : TagRenderer =
fun meta args children -> Element(n, args, children)
@ -72,7 +112,17 @@ module Parser =
let isSection (name: string) = name.EndsWith("section") let isSection (name: string) = name.EndsWith("section")
let pNewline = newline let pNewline = newline
let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces 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 pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ",")) let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
// --- 1. Måsvinge-parser (för @kommandon) --- // --- 1. Måsvinge-parser (för @kommandon) ---
@ -83,9 +133,17 @@ module Parser =
pchar '{' >>. pRawBodyRef.Value .>> pchar '}' |>> sprintf "{%s}" pchar '{' >>. pRawBodyRef.Value .>> pchar '}' |>> sprintf "{%s}"
]) |>> String.concat "" ]) |>> String.concat ""
let pBody: Parser<InlineNode list,unit> = let pBody =
between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw -> between (pstring "{") (pstring "}") pRawBodyRef.Value >>= fun raw ->
match run (many pInline .>> eof) (Utils.smartDedent raw) with // 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 | Success(n, _, _) -> preturn n
| Failure(m, _, _) -> fail m | Failure(m, _, _) -> fail m
@ -187,7 +245,6 @@ module Execution =
let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (eval: IEvaluator) = function let rec transform (metadata: Map<string, string>) (prelude: Map<string, TagRenderer>) (eval: IEvaluator) = function
| Element(n, a, c) when prelude.ContainsKey n -> | Element(n, a, c) when prelude.ContainsKey n ->
// Skicka in metadata som första argument till din funktion
prelude.[n] metadata a (c |> List.map (transform metadata prelude eval)) prelude.[n] metadata a (c |> List.map (transform metadata prelude eval))
| Element(n, a, c) -> | Element(n, a, c) ->
Element(n, a, c |> List.map (transform metadata prelude eval)) Element(n, a, c |> List.map (transform metadata prelude eval))
@ -196,17 +253,35 @@ module Execution =
module HtmlPrinter = module HtmlPrinter =
open Ast 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 = let rec renderInline =
function function
| Text t -> WebUtility.HtmlEncode t | Text t -> WebUtility.HtmlEncode t
| RawHtml h -> h | RawHtml h -> h
| Element(t, a, c) -> sprintf "<%s>%s</%s>" t (c |> List.map renderInline |> String.concat "") t | 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) = let render (header, blocks) =
blocks blocks
|> List.map (function |> 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 "") | 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) | Section(l, _, c) -> sprintf "<h%d>%s</h%d>" l (c |> List.map renderInline |> String.concat "") l)
|> String.concat "\n" |> String.concat "\n"

38
src/FibLib/Pandoc.fs Normal file
View file

@ -0,0 +1,38 @@
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 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<pre>%s</pre> and <pre>%s</pre>" errorOutput markdownText
with ex ->
// Fångar upp om Pandoc inte är installerat eller inte finns i PATH
sprintf "\n<pre>%s</pre> and <pre>%s</pre>" ex.Message markdownText
let mdToHtml markdownText =
toHtml "markdown" markdownText

5
src/FibLib/strip-p.lua Normal file
View file

@ -0,0 +1,5 @@
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