<commit_before>﻿namespace FShade

open Aardvark.Base
open Aardvark.Base.Incremental
open FShade.Debug
open System.IO
open System.Collections.Concurrent
open Microsoft.FSharp.Quotations
open FShade.Imperative

module EffectDebugger =
    
    [<AutoOpen>]
    module private Helpers =
        
        module List =
            let rec mapOption (f : 'a -> Option<'b>) (l : list<'a>) =
                match l with
                    | [] -> Some []
                    | h :: t ->
                        match f h with
                            | Some h ->
                                match mapOption f t with
                                    | Some t -> Some (h :: t)
                                    | None -> None
                            | None ->
                                None

        let rec getLeafs (e : Effect) =
            match e.ComposedOf with
                | [] -> [e]
                | l -> l |> List.collect getLeafs

        let tryGetName (e : Effect) =
            let leafs = getLeafs e

            let names = 
                leafs |> List.mapOption (fun e ->
                    match e.SourceDefintion with
                        | Some (e,t) ->
                            match CodeGenerator.Code.TryGetReflectedDefinition e with
                                | Some def -> Some def.name
                                | None -> None
                        | None ->
                            None
                )



            match names with
                | Some names ->
//                    let idHash = md5.ComputeHash(System.Text.Encoding.UTF8.GetBytes e.Id) |> System.Convert.ToBase64String
//                    let idHash = idHash.Replace("=", "").Replace("/", "_").Replace("+", "_")
//
//                    let names = names @ [idHash]
                    let name = String.concat "_" names
                    Some name
                | None ->
                    None

    let private registered = Dict<string, Effect * ModRef<Effect>>()
    let private lockObj = obj()

    let private sem = new System.Threading.SemaphoreSlim(0)
    let private queue = ConcurrentHashQueue<string>()
    let private compiledContent = Dict<string, string>()

    
    let private md5 = System.Security.Cryptography.MD5.Create()

    let private getCompositionName (e : Effect) =
        md5.ComputeHash(System.Text.Encoding.UTF8.GetBytes e.Id) |> System.Guid |> string


    let private updateCompiled (file : string) (code : string) (f : unit -> unit) =
        lock compiledContent (fun () ->
            match compiledContent.TryGetValue file with 
                | (true, compiled) when code = compiled -> 
                    ()
                | _ ->
                    try 
                        f()
                        compiledContent.[file] <- code
                    with _ ->
                        ()
        )

    let private compileFile (path : string) =
        lock lockObj (fun () ->
            let name = Path.GetFileNameWithoutExtension path
            match registered.TryGetValue name with
                | (true, (_,evt)) ->
                    Log.startTimed "[FShade] compile %s" name
                    match EffectCompiler.tryCompile path with
                        | Choice1Of2 e -> 
                            transact (fun () -> evt.Value <- e)
                        | Choice2Of2 errors -> 
                            for e in errors do Log.warn "%A" e
                    Log.stop()
                | _ ->
                    ()
        )

    let unknownCache = Dict<string, Effect>()
    let compositions = Dict<string, ModRef<list<string>> * IMod<Effect>>()

    let private compChanged (file : string) =
        let name = Path.GetFileNameWithoutExtension file
        match compositions.TryGetValue name with
            | (true, (r,_)) ->
                let lines = File.ReadAllLines(file) |> Array.toList |> List.filter (System.String.IsNullOrWhiteSpace >> not)
                transact (fun () -> r.Value <- lines)
            | _ ->
                ()


    let private run(o : obj) =
        while true do
            sem.Wait()
            // swallow duplicate changes
            System.Threading.Thread.Sleep(30)
            match queue.TryDequeue() with
                | (true, file) ->
                    let code = 
                        try File.ReadAllText file
                        with _ -> 
                            Log.warn "[FShade] could not read %A" (Path.GetFileName file)
                            System.Guid.NewGuid() |> string

                    try
                        if Path.GetExtension file = ".comp" then
                            compChanged file
                        else
                            updateCompiled file code (fun () ->
                                compileFile file
                            )
                    with _ -> 
                        Log.warn "[FShade] updating %A failed" (Path.GetFileName file)
                | _ ->
                    ()

    let private thread = new System.Threading.Thread(System.Threading.ThreadStart(run), IsBackground = true)

    let private changed (f : string) =
        if queue.Enqueue f then
            Log.line "[FShade] changed %A" (Path.GetFileName f)
            sem.Release() |> ignore

    let private tryRegister (e : Effect) =
        lock lockObj (fun () ->
            if EffectDebugger.isAttached then
                match tryGetName e with
                    | Some name ->
                        match registered.TryGetValue name with
                            | (true, (o,evt)) -> 
                                Some (name, evt :> IMod<_>)
                            | _ -> 
                                match CodeGenerator.tryGetCode e with
                                    | Some code ->
                                        let evt = Mod.init e
                                        registered.[name] <- (e, evt)

                                        let fileName = name + ".fsx"
                                        let filePath = Path.Combine(EffectCompiler.debugDir, fileName)
                                        updateCompiled filePath code id

                                        File.WriteAllText(filePath, code)
                                        Git.add EffectCompiler.debugDir fileName
                                        Git.amend EffectCompiler.debugDir


                                        changed filePath

                                        Some (name, evt :> IMod<_>)
                        
                                    | None ->
                                        None
                    | None ->
                        None
            else
                None
        )

    let private register (e : Effect) =
        match tryRegister e with
            | Some (name, e) -> e
            | None -> Mod.constant e

    let private printConfig = { EffectConfig.empty with outputs = Map.ofList ["Colors", (typeof<V4d>, 0) ] }
    let private glslNames = Dict<Effect, string>()
    let private registerOutput (name : string) (effect : Effect) =
        glslNames.[effect] <- name
        effect

    let private printOutput (effect : Effect) (code : string) =
        match glslNames.TryGetValue effect with
            | (true, name) ->
                let file = Path.Combine(EffectCompiler.outDir, name + ".glsl")
                File.WriteAllText(file, code)
            | _ -><commit_msg>[Debug] effect cache used ids instead of references<commit_after>﻿namespace FShade

open Aardvark.Base
open Aardvark.Base.Incremental
open FShade.Debug
open System.IO
open System.Collections.Concurrent
open Microsoft.FSharp.Quotations
open FShade.Imperative

module EffectDebugger =
    
    [<AutoOpen>]
    module private Helpers =
        
        module List =
            let rec mapOption (f : 'a -> Option<'b>) (l : list<'a>) =
                match l with
                    | [] -> Some []
                    | h :: t ->
                        match f h with
                            | Some h ->
                                match mapOption f t with
                                    | Some t -> Some (h :: t)
                                    | None -> None
                            | None ->
                                None

        let rec getLeafs (e : Effect) =
            match e.ComposedOf with
                | [] -> [e]
                | l -> l |> List.collect getLeafs

        let tryGetName (e : Effect) =
            let leafs = getLeafs e

            let names = 
                leafs |> List.mapOption (fun e ->
                    match e.SourceDefintion with
                        | Some (e,t) ->
                            match CodeGenerator.Code.TryGetReflectedDefinition e with
                                | Some def -> Some def.name
                                | None -> None
                        | None ->
                            None
                )



            match names with
                | Some names ->
//                    let idHash = md5.ComputeHash(System.Text.Encoding.UTF8.GetBytes e.Id) |> System.Convert.ToBase64String
//                    let idHash = idHash.Replace("=", "").Replace("/", "_").Replace("+", "_")
//
//                    let names = names @ [idHash]
                    let name = String.concat "_" names
                    Some name
                | None ->
                    None

    let private registered = Dict<string, Effect * ModRef<Effect>>()
    let private lockObj = obj()

    let private sem = new System.Threading.SemaphoreSlim(0)
    let private queue = ConcurrentHashQueue<string>()
    let private compiledContent = Dict<string, string>()

    
    let private md5 = System.Security.Cryptography.MD5.Create()

    let private getCompositionName (e : Effect) =
        md5.ComputeHash(System.Text.Encoding.UTF8.GetBytes e.Id) |> System.Guid |> string


    let private updateCompiled (file : string) (code : string) (f : unit -> unit) =
        lock compiledContent (fun () ->
            match compiledContent.TryGetValue file with 
                | (true, compiled) when code = compiled -> 
                    ()
                | _ ->
                    try 
                        f()
                        compiledContent.[file] <- code
                    with _ ->
                        ()
        )

    let private compileFile (path : string) =
        lock lockObj (fun () ->
            let name = Path.GetFileNameWithoutExtension path
            match registered.TryGetValue name with
                | (true, (_,evt)) ->
                    Log.startTimed "[FShade] compile %s" name
                    match EffectCompiler.tryCompile path with
                        | Choice1Of2 e -> 
                            transact (fun () -> evt.Value <- e)
                        | Choice2Of2 errors -> 
                            for e in errors do Log.warn "%A" e
                    Log.stop()
                | _ ->
                    ()
        )

    let unknownCache = Dict<string, Effect>()
    let compositions = Dict<string, ModRef<list<string>> * IMod<Effect>>()

    let private compChanged (file : string) =
        let name = Path.GetFileNameWithoutExtension file
        match compositions.TryGetValue name with
            | (true, (r,_)) ->
                let lines = File.ReadAllLines(file) |> Array.toList |> List.filter (System.String.IsNullOrWhiteSpace >> not)
                transact (fun () -> r.Value <- lines)
            | _ ->
                ()


    let private run(o : obj) =
        while true do
            sem.Wait()
            // swallow duplicate changes
            System.Threading.Thread.Sleep(30)
            match queue.TryDequeue() with
                | (true, file) ->
                    let code = 
                        try File.ReadAllText file
                        with _ -> 
                            Log.warn "[FShade] could not read %A" (Path.GetFileName file)
                            System.Guid.NewGuid() |> string

                    try
                        if Path.GetExtension file = ".comp" then
                            compChanged file
                        else
                            updateCompiled file code (fun () ->
                                compileFile file
                            )
                    with _ -> 
                        Log.warn "[FShade] updating %A failed" (Path.GetFileName file)
                | _ ->
                    ()

    let private thread = new System.Threading.Thread(System.Threading.ThreadStart(run), IsBackground = true)

    let private changed (f : string) =
        if queue.Enqueue f then
            Log.line "[FShade] changed %A" (Path.GetFileName f)
            sem.Release() |> ignore

    let private tryRegister (e : Effect) =
        lock lockObj (fun () ->
            if EffectDebugger.isAttached then
                match tryGetName e with
                    | Some name ->
                        match registered.TryGetValue name with
                            | (true, (o,evt)) -> 
                                Some (name, evt :> IMod<_>)
                            | _ -> 
                                match CodeGenerator.tryGetCode e with
                                    | Some code ->
                                        let evt = Mod.init e
                                        registered.[name] <- (e, evt)

                                        let fileName = name + ".fsx"
                                        let filePath = Path.Combine(EffectCompiler.debugDir, fileName)
                                        updateCompiled filePath code id

                                        File.WriteAllText(filePath, code)
                                        Git.add EffectCompiler.debugDir fileName
                                        Git.amend EffectCompiler.debugDir


                                        changed filePath

                                        Some (name, evt :> IMod<_>)
                        
                                    | None ->
                                        None
                    | None ->
                        None
            else
                None
        )

    let private register (e : Effect) =
        match tryRegister e with
            | Some (name, e) -> e
            | None -> Mod.constant e

    let private printConfig = { EffectConfig.empty with outputs = Map.ofList ["Colors", (typeof<V4d>, 0) ] }
    let private glslNames = Dict<string, string>()
    let private registerOutput (name : string) (effect : Effect) =
        glslNames.[effect.Id] <- name
        effect

    let private printOutput (effect : Effect) (code : string) =
        match glslNames.TryGetValue effect.Id with
            | (true, name) ->
                let file = Path.Combine(EffectCompiler.outDir, name + ".glsl")
                File.WriteAllText(file, code)
            | _ ->
{'fraction_non_alphanumeric': 0.08627295547628484, 'fraction_numerical': 0.002246003435064077, 'mean_word_length': 1.0277256897937317, 'pattern_counts': {'":': 0, '<': 45, '<?xml version=': 0, '>': 153, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 48, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1059684', 'n_tokens_mistral': 3644, 'n_tokens_neox': 3432, 'n_words': 975}