<commit_before>﻿// Nu Game Engine.
// Copyright (C) <NAME>, 2013-2017.

namespace Nu
open System
open System.Collections.Generic
open FSharp.Reflection
open OpenTK
open Prime
open Prime.Scripting
open Nu
#nowarn "22"
#nowarn "40"

[<AutoOpen>]
module WorldScripting =

    let mutable Extrinsics =
        Unchecked.defaultof<Dictionary<string, string -> Expr array -> SymbolOrigin option -> World -> struct (Expr * World)>>

    let mutable Bindings =
        Unchecked.defaultof<Dictionary<string, string -> Expr array -> SymbolOrigin option -> World -> struct (Expr * World)>>

    type World with

        static member internal evalInternal expr world : struct (Expr * World) =
            ScriptingWorld.eval expr world

        static member internal evalManyInternal exprs world : struct (Expr array * World) =
            ScriptingWorld.evalMany exprs world

        static member internal evalWithLoggingInternal expr world : struct (Expr * World) =
            ScriptingWorld.evalWithLogging expr world

        static member internal evalManyWithLoggingInternal exprs world : struct (Expr array * World) =
            ScriptingWorld.evalManyWithLogging exprs world

        static member internal evalSimulantExists fnName evaledArg originOpt world =
            match evaledArg with
            | String str
            | Keyword str ->
                let context = World.getScriptContext world
                let relation = Relation.makeFromString str
                let address = Relation.resolve context.SimulantAddress relation
                match World.tryDeriveSimulant address with
                | Some simulant -> struct (Bool (World.getSimulantExists simulant world), world)
                | None -> struct (Bool false, world)
            | Violation _ as error -> struct (error, world)
            | _ -> struct (Violation (["InvalidArgumentType"; "SimulantExists"], "Function '" + fnName + "' requires 1 Relation argument.", originOpt), world)

        static member internal evalGet propertyName relationExprOpt originOpt world =
            let context = World.getScriptContext world
            let simulantAndEnvEir =
                match relationExprOpt with
                | Some relationExpr ->
                    match World.evalInternal relationExpr world with
                    | struct (String str, world)
                    | struct (Keyword str, world) ->
                        let relation = Relation.makeFromString str
                        let address = Relation.resolve context.SimulantAddress relation
                        match World.tryDeriveSimulant address with
                        | Some simulant -> Right struct (simulant, world)
                        | None -> Left struct (Violation (["InvalidPropertyRelation"; "Get"], "Relation must have 0 to 3 names.", originOpt), world)
                    | struct (Violation _, _) as error -> Left error
                    | struct (_, world) -> Left struct (Violation (["InvalidPropertyRelation"; "Get"], "Relation must be either a String or Keyword.", originOpt), world)
                | None -> Right struct (context, world)
            match simulantAndEnvEir with
            | Right struct (simulant, world) ->
                match World.tryGetSimulantProperty propertyName simulant world with
                | Some property ->
                    match property.PropertyValue with
                    | :? DesignerProperty as dp ->
                        match ScriptingWorld.tryImport dp.DesignerType dp.DesignerValue world with
                        | Some propertyValue -> struct (propertyValue, world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Get"], "Property value could not be imported into scripting environment.", originOpt), world)
                    | _ ->
                        match ScriptingWorld.tryImport property.PropertyType property.PropertyValue world with
                        | Some propertyValue -> struct (propertyValue, world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Get"], "Property value could not be imported into scripting environment.", originOpt), world)
                | None -> struct (Violation (["InvalidProperty"; "Get"], "Simulant or property value could not be found.", originOpt), world)
            | Left error -> error

        static member internal evalSet propertyName relationExprOpt propertyValueExpr originOpt world =
            let context = World.getScriptContext world
            let simulantAndEnvEir =
                match relationExprOpt with
                | Some relationExpr ->
                    match World.evalInternal relationExpr world with
                    | struct (String str, world)
                    | struct (Keyword str, world) ->
                        let relation = Relation.makeFromString str
                        let address = Relation.resolve context.SimulantAddress relation
                        match World.tryDeriveSimulant address with
                        | Some simulant -> Right struct (simulant, world)
                        | None -> Left struct (Violation (["InvalidPropertyRelation"; "Set"], "Relation must have 0 to 3 parts.", originOpt), world)
                    | struct (Violation _, _) as error -> Left error
                    | struct (_, world) -> Left struct (Violation (["InvalidPropertyRelation"; "Set"], "Relation must be either a String or Keyword.", originOpt), world)
                | None -> Right struct (context, world)
            match simulantAndEnvEir with
            | Right struct (simulant, world) ->
                match World.tryGetSimulantProperty propertyName simulant world with
                | Some property ->
                    let struct (propertyValue, world) = World.evalInternal propertyValueExpr world
                    match property.PropertyValue with
                    | :? DesignerProperty as dp ->
                        match ScriptingWorld.tryExport property.PropertyType propertyValue world with
                        | Some propertyValue ->
                            let propertyValue = { dp with DesignerValue = propertyValue }
                            let property = { PropertyType = property.PropertyType; PropertyValue = propertyValue }
                            match World.trySetSimulantProperty propertyName property simulant world with
                            | (true, world) -> struct (Unit, world)
                            | (false, world) -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Set"], "Property value could not be exported into Simulant property.", originOpt), world)
                    | _ ->
                        match ScriptingWorld.tryExport property.PropertyType propertyValue world with
                        | Some propertyValue ->
                            let property = { PropertyType = property.PropertyType; PropertyValue = propertyValue }
                            match World.trySetSimulantProperty propertyName property simulant world with
                            | (true, world) -> struct (Unit, world)
                            | (false, world) -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Set"], "Property value could not be exported into Simulant property.", originOpt), world)
                | None -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
            | Left error -> error

        static member private evalMonitor5 subscription (eventAddress : obj Address) subscriber world =
            EventWorld.subscribe (fun evt world ->
                match World.tryGetSimulantScriptFrame subscriber world with
                | Some scriptFrame ->
                    match ScriptingWorld.tryImport evt.DataType evt.Data world with
                    | Some dataImported ->
                        let evtRecord =
                            Record
                                ("Event",
                                 [|"Data", 0; "Subscriber", 1; "Publisher", 2; "Address", 3|] |> Map.ofArray,
                                 [|dataImported
                                   String (scstring evt.Subscriber)
                                   String (scstring evt.Publisher)
                                   String (scstring evt.Address)|])
                        let breakpoint = { BreakEnabled = false; BreakCondition = Unit }
                        let application = Apply ([|subscription; evtRecord|], breakpoint, None)
                        World.evalWithLogging application scriptFrame subscriber world |> snd
                    | None -> Log.info "Property value could not be imported into scripting environment."; world
                | None -> world)
                eventAddress
                (subscriber :> Participant)
                world

        static member private evalMonitor fnName evaledArg evaledArg2 originOpt world =
            match evaledArg with
            | Binding _
            | Fun _ ->
                match evaledArg2 with
                | String str
                | Keyword str ->
                    let world = World.evalMonitor5 evaledArg (Address.makeFromString str) (World.getScriptContext world) world
                    struct (Unit, world)
                | Violation _ as error -> struct (error, world)
                | _ -> struct (Violation (["InvalidArgumentType"; String.capitalize fnName], "Function '" + fnName + "' requires a Relation for its 2nd argument.", originOpt), world)
            | Violation _ as error -> struct (error, world)
            | _ -> struct (Violation (["InvalidArgumentType"; String.capitalize fnName], "Function '" + fnName + "' requires a Function for its 1st argument.", originOpt), world)

        /// Attempt to get a static type that matches the given expression.
        static member tryGetType expr =
            match expr with
            | Scripting.Violation _ -> None
            | Scripting.Unit -> Some typeof<unit>
            | Scripting.Bool _ -> Some typeof<bool>
            | Scripting.Int _ -> Some typeof<int>
            | Scripting.Int64 _ -> Some typeof<int64>
            | Scripting.Single _ -> Some typeof<single>
            | Scripting.Double _ -> Some typeof<double>
            | Scripting.String _ -> Some typeof<string>
            | Scripting.Keyword _ -> None
            | Scripting.Pluggable value ->
                // TODO: P1: use a virtual dispatching?
                match value with
                | :? Vector2Pluggable -> Some typeof<Vector2>
                | :? Vector4Pluggable -> Some typeof<Vector4>
                | :? Vector2iPluggable -> Some typeof<Vector2i>
                | _ -> None
            | Scripting.Tuple value ->
                let typeOpts = Array.map World.tryGetType value
                match Array.definitizePlus typeOpts with
                | (true, types) -> Some (FSharpType.MakeTupleType types)
                | (false, _) -> None
            | Scripting.Option value ->
                match value with
                | Some value' -> World.tryGetType value'
                | None -> None
            | Scripting.List values ->
                let typeOpts = List.map World.tryGetType values<commit_msg>More work.<commit_after>﻿// Nu Game Engine.
// Copyright (C) <NAME>, 2013-2017.

namespace Nu
open System
open System.Collections.Generic
open FSharp.Reflection
open OpenTK
open Prime
open Prime.Scripting
open Nu
#nowarn "22"
#nowarn "40"

[<AutoOpen>]
module WorldScripting =

    let mutable Extrinsics =
        Unchecked.defaultof<Dictionary<string, string -> Expr array -> SymbolOrigin option -> World -> struct (Expr * World)>>

    let mutable Bindings =
        Unchecked.defaultof<Dictionary<string, string -> Expr array -> SymbolOrigin option -> World -> struct (Expr * World)>>

    type World with

        static member internal evalInternal expr world : struct (Expr * World) =
            ScriptingWorld.eval expr world

        static member internal evalManyInternal exprs world : struct (Expr array * World) =
            ScriptingWorld.evalMany exprs world

        static member internal evalWithLoggingInternal expr world : struct (Expr * World) =
            ScriptingWorld.evalWithLogging expr world

        static member internal evalManyWithLoggingInternal exprs world : struct (Expr array * World) =
            ScriptingWorld.evalManyWithLogging exprs world

        static member internal evalSimulantExists fnName evaledArg originOpt world =
            match evaledArg with
            | String str
            | Keyword str ->
                let context = World.getScriptContext world
                let relation = Relation.makeFromString str
                let address = Relation.resolve context.SimulantAddress relation
                match World.tryDeriveSimulant address with
                | Some simulant -> struct (Bool (World.getSimulantExists simulant world), world)
                | None -> struct (Bool false, world)
            | Violation _ as error -> struct (error, world)
            | _ -> struct (Violation (["InvalidArgumentType"; "SimulantExists"], "Function '" + fnName + "' requires 1 Relation argument.", originOpt), world)

        static member internal evalGet propertyName relationExprOpt originOpt world =
            let context = World.getScriptContext world
            let simulantAndEnvEir =
                match relationExprOpt with
                | Some relationExpr ->
                    match World.evalInternal relationExpr world with
                    | struct (String str, world)
                    | struct (Keyword str, world) ->
                        let relation = Relation.makeFromString str
                        let address = Relation.resolve context.SimulantAddress relation
                        match World.tryDeriveSimulant address with
                        | Some simulant -> Right struct (simulant, world)
                        | None -> Left struct (Violation (["InvalidPropertyRelation"; "Get"], "Relation must have 0 to 3 names.", originOpt), world)
                    | struct (Violation _, _) as error -> Left error
                    | struct (_, world) -> Left struct (Violation (["InvalidPropertyRelation"; "Get"], "Relation must be either a String or Keyword.", originOpt), world)
                | None -> Right struct (context, world)
            match simulantAndEnvEir with
            | Right struct (simulant, world) ->
                match World.tryGetSimulantProperty propertyName simulant world with
                | Some property ->
                    match property.PropertyValue with
                    | :? DesignerProperty as dp ->
                        match ScriptingWorld.tryImport dp.DesignerType dp.DesignerValue world with
                        | Some propertyValue -> struct (propertyValue, world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Get"], "Property value could not be imported into scripting environment.", originOpt), world)
                    | _ ->
                        match ScriptingWorld.tryImport property.PropertyType property.PropertyValue world with
                        | Some propertyValue -> struct (propertyValue, world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Get"], "Property value could not be imported into scripting environment.", originOpt), world)
                | None -> struct (Violation (["InvalidProperty"; "Get"], "Simulant or property value could not be found.", originOpt), world)
            | Left error -> error

        static member internal evalSet propertyName relationExprOpt propertyValueExpr originOpt world =
            let context = World.getScriptContext world
            let simulantAndEnvEir =
                match relationExprOpt with
                | Some relationExpr ->
                    match World.evalInternal relationExpr world with
                    | struct (String str, world)
                    | struct (Keyword str, world) ->
                        let relation = Relation.makeFromString str
                        let address = Relation.resolve context.SimulantAddress relation
                        match World.tryDeriveSimulant address with
                        | Some simulant -> Right struct (simulant, world)
                        | None -> Left struct (Violation (["InvalidPropertyRelation"; "Set"], "Relation must have 0 to 3 parts.", originOpt), world)
                    | struct (Violation _, _) as error -> Left error
                    | struct (_, world) -> Left struct (Violation (["InvalidPropertyRelation"; "Set"], "Relation must be either a String or Keyword.", originOpt), world)
                | None -> Right struct (context, world)
            match simulantAndEnvEir with
            | Right struct (simulant, world) ->
                match World.tryGetSimulantProperty propertyName simulant world with
                | Some property ->
                    let struct (propertyValue, world) = World.evalInternal propertyValueExpr world
                    match property.PropertyValue with
                    | :? DesignerProperty as dp ->
                        match ScriptingWorld.tryExport property.PropertyType propertyValue world with
                        | Some propertyValue ->
                            let propertyValue = { dp with DesignerValue = propertyValue }
                            let property = { PropertyType = property.PropertyType; PropertyValue = propertyValue }
                            match World.trySetSimulantProperty propertyName property simulant world with
                            | (true, world) -> struct (Unit, world)
                            | (false, world) -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Set"], "Property value could not be exported into Simulant property.", originOpt), world)
                    | _ ->
                        match ScriptingWorld.tryExport property.PropertyType propertyValue world with
                        | Some propertyValue ->
                            let property = { PropertyType = property.PropertyType; PropertyValue = propertyValue }
                            match World.trySetSimulantProperty propertyName property simulant world with
                            | (true, world) -> struct (Unit, world)
                            | (false, world) -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
                        | None -> struct (Violation (["InvalidPropertyValue"; "Set"], "Property value could not be exported into Simulant property.", originOpt), world)
                | None -> struct (Violation (["InvalidProperty"; "Set"], "Property value could not be set.", originOpt), world)
            | Left error -> error

        static member private evalMonitor5 subscription (eventAddress : obj Address) subscriber world =
            EventWorld.subscribe (fun evt world ->
                match World.tryGetSimulantScriptFrame subscriber world with
                | Some scriptFrame ->
                    match ScriptingWorld.tryImport evt.DataType evt.Data world with
                    | Some dataImported ->
                        let evtRecord =
                            Record
                                ("Event",
                                 [|"Data", 0; "Subscriber", 1; "Publisher", 2; "Address", 3|] |> Map.ofArray,
                                 [|dataImported
                                   String (scstring evt.Subscriber)
                                   String (scstring evt.Publisher)
                                   String (scstring evt.Address)|])
                        let breakpoint = { BreakEnabled = false; BreakCondition = Unit }
                        let application = Apply ([|subscription; evtRecord|], breakpoint, None)
                        World.evalWithLogging application scriptFrame subscriber world |> snd
                    | None -> Log.info "Property value could not be imported into scripting environment."; world
                | None -> world)
                eventAddress
                (subscriber :> Participant)
                world

        static member private evalMonitor fnName evaledArg evaledArg2 originOpt world =
            match evaledArg with
            | Binding _
            | Fun _ ->
                match evaledArg2 with
                | String str
                | Keyword str ->
                    let world = World.evalMonitor5 evaledArg (Address.makeFromString str) (World.getScriptContext world) world
                    struct (Unit, world)
                | Violation _ as error -> struct (error, world)
                | _ -> struct (Violation (["InvalidArgumentType"; String.capitalize fnName], "Function '" + fnName + "' requires a Relation for its 2nd argument.", originOpt), world)
            | Violation _ as error -> struct (error, world)
            | _ -> struct (Violation (["InvalidArgumentType"; String.capitalize fnName], "Function '" + fnName + "' requires a Function for its 1st argument.", originOpt), world)

        /// Attempt to get a static type that matches the given expression.
        /// TODO: P1: move the major portion of this to Prime.Scripting.
        static member tryGetType expr =
            match expr with
            | Scripting.Violation _ -> None
            | Scripting.Unit -> Some typeof<unit>
            | Scripting.Bool _ -> Some typeof<bool>
            | Scripting.Int _ -> Some typeof<int>
            | Scripting.Int64 _ -> Some typeof<int64>
            | Scripting.Single _ -> Some typeof<single>
            | Scripting.Double _ -> Some typeof<double>
            | Scripting.String _ -> Some typeof<string>
            | Scripting.Keyword keyword ->
                let types =
                    AppDomain.CurrentDomain.GetAssemblies () |>
                    Array.map (fun asm -> asm.GetTypes ()) |>
                    Array.concat
                let candidateUnions =
                    types |>
                    Array.map (fun ty -> FSharpType.GetUnionCases ty) |>
                    Array.concat |>
                    Array.filter (fun uc -> uc.Name = keyword) |>
                    Array.map (fun uc -> uc.DeclaringType)
                let candidateTypes =
                    types |>
                    Array.filter (fun ty -> ty.Name = keyword) |>
                    Array.filter (fun ty -> ty.GenericTypeArguments.Length = 0) |> // generic algebraic data types not yet supported...
                    Array.append candidateUnions
                // just take the first found type for now...
                Array.tryHead candidateTypes
            | Scripting.Pluggable value ->
                // TODO: P1: use a virtual dispatching?
                match value with
                | :? Vector2Pluggable -> Some typeof<Vector2>
                | :? Vector4Pluggable -> Some typeof<Vector4>
                | :? Vector2iPluggable -> Some typeof<Vector2i>
                | _ -> None
            | Scripting.Tuple value ->
                let typeOpts = Array.map World.tryGetType value
                match Array.definitizePlus typeOpts with
                | (true, types) -> Some (FSharpType.MakeTupleType types)
                | (false, _) -> None
            | Scripting.Option value ->
                match value with
                | Some value' -> World.tryGetType value'
                | None -> None
            | Scripting.List values ->
                let typeOpts = List.map World.tryGetType values
{'fraction_non_alphanumeric': 0.07904107320304736, 'fraction_numerical': 0.0032295462073534285, 'mean_word_length': 1.7359537834164023, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 222, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5158054', 'n_tokens_mistral': 5585, 'n_tokens_neox': 5326, 'n_words': 1834}