Fibble/src/FibLib/Library.fs

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)