First commit
This commit is contained in:
commit
b6b2958592
4 changed files with 292 additions and 0 deletions
192
src/FibLib/Library.fs
Normal file
192
src/FibLib/Library.fs
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
namespace Fibble.FibLib
|
||||
open System.Net
|
||||
open FParsec
|
||||
open YamlDotNet.Serialization
|
||||
open System.Collections.Generic
|
||||
|
||||
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
|
||||
|
||||
// ==========================================
|
||||
// 2. Parser (FParsec)
|
||||
// ==========================================
|
||||
module Parser =
|
||||
open Ast
|
||||
|
||||
let pInline, pInlineRef = createParserForwardedToRef<InlineNode, unit>()
|
||||
|
||||
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")
|
||||
|
||||
// --- Nya parsers för argument och body ---
|
||||
let pArg = spaces >>. manyChars (noneOf ",]") .>> spaces
|
||||
let pArgs = between (pstring "[") (pstring "]") (sepBy pArg (pstring ","))
|
||||
let pBody = between (pstring "{") (pstring "}") (many pInline)
|
||||
|
||||
// --- Inline Parsers ---
|
||||
let pExpr = attempt (pstring "@(") >>. manyChars (noneOf ")") .>> pstring ")" |>> fun c -> Expr(c, None)
|
||||
let pMetaRef = attempt (pstring "@value{") >>. many1Chars (noneOf "}") .>> pstring "}" |>> MetaRef
|
||||
|
||||
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 ((name, argsOpt), bodyOpt) ->
|
||||
let args = defaultArg argsOpt []
|
||||
let body = defaultArg bodyOpt []
|
||||
Element(name, args, body)
|
||||
|
||||
let pText = many1Chars (noneOf "@{}\n\r") |>> Text
|
||||
let pNewline = newline
|
||||
let pSingleNewline = attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n"
|
||||
|
||||
pInlineRef.Value <- choice [ pExpr; pMetaRef; pInlineCommand; pText; pSingleNewline ]
|
||||
|
||||
// --- 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) ->
|
||||
let args = defaultArg argsOpt []
|
||||
let body = defaultArg bodyOpt []
|
||||
Section(getSectionLevel name, args, body)
|
||||
|
||||
let pParagraphBlock = many1 pInline |>> Paragraph
|
||||
|
||||
let pBlock = choice [ pSectionBlock; pParagraphBlock ]
|
||||
|
||||
// --- YAML Header Parser ---
|
||||
let pYamlHeader =
|
||||
// Letar efter radbrytning, följt av ---, följt av radbrytning (eller filens slut)
|
||||
let endMarker = attempt (newline >>. pstring "---" >>. (skipNewline <|> eof))
|
||||
// Matchar --- i början, läser allt som text fram till endMarker
|
||||
pstring "---" >>. newline >>. manyCharsTill anyChar endMarker
|
||||
|>> fun yamlStr ->
|
||||
let deserializer = DeserializerBuilder().Build()
|
||||
try
|
||||
let dict = deserializer.Deserialize<Dictionary<string, string>>(yamlStr)
|
||||
if isNull dict then Map.empty
|
||||
else dict |> Seq.map (fun kvp -> kvp.Key, kvp.Value) |> Map.ofSeq
|
||||
with _ -> Map.empty
|
||||
|
||||
// --- Dokument Parser ---
|
||||
let pDocument =
|
||||
spaces >>. opt pYamlHeader .>> spaces .>>. sepEndBy pBlock (many1 pNewline)
|
||||
|>> fun (headerOpt, blocks) ->
|
||||
(defaultArg headerOpt Map.empty, blocks)
|
||||
|
||||
let parse (input: string) : Map<string, string> * Document =
|
||||
match run pDocument input with
|
||||
| Success(result, _, _) -> result
|
||||
| Failure(errorMsg, _, _) -> failwithf "Kunde inte parsa dokumentet:\n%s" errorMsg
|
||||
|
||||
// ==========================================
|
||||
// 3. Evaluator
|
||||
// ==========================================
|
||||
type IEvaluator =
|
||||
abstract member Evaluate: code:string -> string
|
||||
|
||||
module Execution =
|
||||
open Ast
|
||||
|
||||
let rec evaluateInline (metadata: Map<string, string>) (evaluator: IEvaluator) (node: InlineNode) =
|
||||
match node with
|
||||
| Expr (code, _) ->
|
||||
let result = evaluator.Evaluate(code)
|
||||
RawHtml result
|
||||
| Text t -> Text t
|
||||
| RawHtml h -> RawHtml h
|
||||
| MetaRef key ->
|
||||
match metadata.TryFind key with
|
||||
| Some value -> Text value
|
||||
| None -> Text (sprintf "[Saknad meta: %s]" key)
|
||||
| Element (tag, args, children) ->
|
||||
Element (tag, args, children |> List.map (evaluateInline metadata evaluator))
|
||||
| Text t -> Text t
|
||||
|
||||
let evaluateBlock (metadata: Map<string, string>) (evaluator: IEvaluator) (node: BlockNode) =
|
||||
match node with
|
||||
| Section (level, args, children) -> Section (level, args, children |> List.map (evaluateInline metadata evaluator))
|
||||
| Paragraph children -> Paragraph (children |> List.map (evaluateInline metadata evaluator))
|
||||
|
||||
let evaluateDocument (metadata: Map<string, string>) (evaluator: IEvaluator) (doc: Document) =
|
||||
doc |> List.map (evaluateBlock metadata evaluator)
|
||||
|
||||
// ==========================================
|
||||
// 4. HTML Converter
|
||||
// ==========================================
|
||||
type TagRenderer = string list -> string -> string
|
||||
|
||||
type IConverter =
|
||||
abstract member Convert: doc:Ast.Document * metadata:Map<string, string> -> string
|
||||
|
||||
module Converters =
|
||||
open Ast
|
||||
|
||||
type HtmlTemplateConverter(template: string, prelude: Map<string, TagRenderer>) =
|
||||
|
||||
let rec renderInline = function
|
||||
| Text t -> WebUtility.HtmlEncode(t)
|
||||
| RawHtml h -> h
|
||||
| Expr (_, Some res) -> WebUtility.HtmlEncode(res)
|
||||
| Expr (_, None) -> failwith "Oexekverat uttryck"
|
||||
| MetaRef _ -> failwith "Ogiltig nod vid konvertering"
|
||||
| Element (tag, args, children) ->
|
||||
let renderedChildren = renderInlines children
|
||||
match prelude.TryFind tag with
|
||||
| Some customFunc -> customFunc args renderedChildren
|
||||
| None -> sprintf "<%s>%s</%s>" tag renderedChildren tag // Fallback ignorerar args
|
||||
|
||||
and renderInlines inlines =
|
||||
inlines |> List.map renderInline |> String.concat ""
|
||||
|
||||
let renderBlock = function
|
||||
| Section (level, args, children) ->
|
||||
let tag = sprintf "h%d" level
|
||||
let idAttr = if args.Length > 0 then sprintf " id=\"%s\"" (args.[0].Trim('"')) else ""
|
||||
sprintf "<%s%s>%s</%s>" tag idAttr (renderInlines children) tag
|
||||
| Paragraph children ->
|
||||
sprintf "<p>%s</p>" (renderInlines children)
|
||||
|
||||
interface IConverter with
|
||||
member _.Convert(doc, metadata) =
|
||||
let bodyHtml = doc |> List.map renderBlock |> String.concat "\n\n"
|
||||
let mutable finalHtml = template.Replace("{{body}}", bodyHtml)
|
||||
for kvp in metadata do
|
||||
finalHtml <- finalHtml.Replace(sprintf "{{%s}}" kvp.Key, WebUtility.HtmlEncode(kvp.Value))
|
||||
finalHtml
|
||||
|
||||
// ==========================================
|
||||
// 5. Pipeline & Test
|
||||
// ==========================================
|
||||
module FibLib=
|
||||
let processDocument (source: string) (template: string) (evaluator: IEvaluator) (converter: IConverter) =
|
||||
let (metadata, rawAst) = Parser.parse source
|
||||
let evaluatedAst = Execution.evaluateDocument metadata evaluator rawAst
|
||||
converter.Convert(evaluatedAst, metadata)
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue