Fibble/src/FibLib/Library.fs

namespace Fibble.FibLib


open System
open FParsec
open YamlDotNet.Serialization
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
        | Command of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list

    and BlockNode =
        | BlockCommand of tag: string * args: string list * kwargs: Map<string, string> * children: InlineNode list
        | 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 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 =
        | 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<string, string> }

    type NodeResult =
        | Inline of InlineNode
        | Block of BlockNode

    type TagRenderer = Map<string, string> -> string list -> Map<string, string> -> InlineNode list -> NodeResult





module Utils =
    open Ast

    let dedentNodes (nodes: InlineNode list) =
        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
            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

        let mutable isFirstText = true
        let indentStr = "\n" + String.replicate minIndent " "

        // 2. Applicera formateringen
        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
                            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. 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 _ (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 = "")

        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('"')
        | 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)
        =
        fun _ args children -> f (getArg args k1 0 d1) (getArg args k2 1 d2) children




// ==========================================
// 2. Parser
// ==========================================

module Parser =
    open Ast
    let pseudoRandom = new System.Random()

    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 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

    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
        )
        .>>. manyChars (noneOf ",]")
        |>> fun (k, v) -> k, v.Trim()

    let pPositionalArg =
        // Bara "värde"
        manyChars (noneOf ",]") |>> fun v -> "", v.Trim()

    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


    let pBody, pBodyRef = createParserForwardedToRef<InlineNode list, unit> ()

    // --- 2. Parentes-parser (för @(...) med sträng-stöd) ---
    let pParenBody, pParenBodyRef = createParserForwardedToRef<string, unit> ()

    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)" ]
        )

    let pExpr =
        attempt (pstring "@(") >>. pParenBody .>> pstring ")" |>> fun c -> Expr(c, None)

    // --- Övriga inline-parsers ---

    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 children = defaultArg bodyOpt [] |> Utils.dedentNodes

            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)


    let pInnerInline =
        choice
            [ pAtCommand // Hanterar alla @-baserade noder
              many1Chars (noneOf "@}") |>> Text ] // Denna äter råtext ultrasnabbt

    pBodyRef.Value <- between (pstring "{") (pstring "}") (many pInnerInline)

    pInlineRef.Value <-
        choice
            [ pAtCommand
              many1Chars (noneOf "@{}\n\r") |>> Text
              attempt (pNewline .>> notFollowedBy pNewline) |>> fun _ -> Text "\n" ]
    // --- 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
        .>>. 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, [])

    let pParagraphBlock = many1 pInline |>> Paragraph

    let pBlock = choice [ pSectionBlock; attempt pBlockCommand; pParagraphBlock ]

    let pDocument =
        spaces
        >>. opt (
            pstring "---" >>. manyCharsTill anyChar (attempt (pNewline >>. pstring "---"))
            |>> fun yamlStr ->
                let deserializer = DeserializerBuilder().Build()
                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
        )
        .>> spaces
        .>>. sepEndBy pBlock (many1 pNewline)
        .>> eof
        |>> fun (headerOpt, blocks) -> (defaultArg headerOpt Map.empty, blocks)

    let parse i =
        match run pDocument i with
        | Success(r, _, _) -> r
        | Failure(e, _, _) -> failwith e


[<AbstractClass>]
type IEvaluator() =
    abstract member Evaluate: string -> string
    abstract member NewSession: unit -> unit

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 inStream = new StringReader("")
        let outStream = new StringWriter(sbOut)
        let errStream = new StringWriter(sbErr)

        // Initiera FSI-sessionen
        let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
        let argv = [| "fsi.exe"; "--noninteractive" |]

        let session =
            FsiEvaluationSession.Create(fsiConfig, argv, inStream, outStream, errStream)

        override this.Evaluate(code: string) =
            sbOut.Clear() |> ignore
            sbErr.Clear() |> ignore

            try
                let result, _warnings = session.EvalInteractionNonThrowing(code)

                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()

                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
                            ""
                        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
                        cleanOutput

                | Choice2Of2 ex ->
                    let fsiErrorOutput =
                        if System.String.IsNullOrEmpty(errors) then
                            "Ingen ytterligare FSI-output."
                        else
                            errors

                    sprintf
                        """
                    <div style="color: #721c24; background-color: #f8d7da; border-color: #f5c6cb; padding: 10px; margin-bottom: 10px; border-radius: 5px;">
                        <strong>FSI Exekveringsfel!</strong><br/>
                        <strong>Kod som kördes:</strong> <code>%s</code><br/><br/>
                        <strong>Exception:</strong> %s<br/>
                        <strong>FSI Stderr:</strong> <pre style="margin:0; background: rgba(255,255,255,0.5); padding: 5px;">%s</pre>
                    </div>"""
                        code
                        ex.Message
                        fsiErrorOutput

            with ex ->
                sprintf
                    """<div style="color: red; border: 1px solid red; padding: 10px;">
                            <strong>Kritiskt FSI-systemfel:</strong> %s
                           </div>"""
                    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<string, string>)
        (prelude: Map<string, TagRenderer>)
        (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