namespace UnityTest

open UnityEngine;

type guid
  = System.Guid

module Guid =

  let private sync = new obj();
  let mutable private set = Set.empty<guid>

  let Generate () =
    System.Guid.NewGuid()

  let Exists id =
    Set.contains id set

  let Insert id =
    lock sync (fun () ->
      if Set.contains id set
        then failwith "Duplicate GUID"
        else set <- set.Add id
    )

type CanvasAsset() =
  inherit ScriptableObject()

  [<DefaultValue>]
  [<SerializeField>]
  val mutable Binary : string

type SlotMode
  = In
  | Out

type DataType = {
  Id : guid
  Name : string
  Color : Color
}

type Slot = {
  Id : guid
  TypeId : guid
  Name : string
  Mode : SlotMode
} with
  member x.AllowMultiple =
    false

type NodeType = {
  Id : guid
  Name : string
  SlotsIn : Slot list
  SlotsOut : Slot list
} with
  member x.CreateSlot (id : guid) (mode : SlotMode) (name : string) (dt : DataType) =
    let s = {
      Id = id;
      Mode = mode;
      Name = name;
      TypeId = dt.Id;
    }

    match mode with
    | In -> {x with SlotsIn = s :: x.SlotsIn}
    | Out -> {x with SlotsOut = s :: x.SlotsOut}

  member x.HasSlot (s:Slot) =
    match s.Mode with
    | In -> List.exists (fun s' -> s = s') x.SlotsIn
    | Out -> List.exists (fun s' -> s = s') x.SlotsOut

type Node = {
  Id : guid
  Data : obj
  TypeId : guid
  Position : Vector3
  DynamicType : NodeType option
}

type Link = {
  Id : guid
  Data : obj
  SourceId : guid
  SourceSlotId : guid
  TargetId : guid
  TargetSlotId : guid
}

type Context = {
  Id : guid
  Name : string
  NodeTypes : Map<guid, NodeType>
  DataTypes : Map<guid, DataType>
} with
  member x.HasDataType (dt:DataType) = x.DataTypes.[dt.Id] = dt
  member x.HasNodeType (nt:NodeType) = x.NodeTypes.[nt.Id] = nt

  member x.AddDataType (dt:DataType) =
    if x.HasDataType dt then
      failwith "Data type already exists in context"

    {x with DataTypes = x.DataTypes.Add(dt.Id, dt)}

  member x.AddNodeType (nt:NodeType) =
    if x.HasNodeType nt then
      failwith "Node type already exists in context"

    {x with NodeTypes = x.NodeTypes.Add(nt.Id, nt)}

  member x.FindDataType (id:guid) = Map.find id x.DataTypes
  member x.FindNodeType (id:guid) = Map.find id x.NodeTypes

module ContextLookup =
  let private contexts = ref Map.empty<guid, Context>
  let Register (ct:Context) = contexts := (!contexts).Add(ct.Id, ct)
  let Find (id:guid) = Map.find id !contexts

type Canvas = {
  Id : guid
  ContextId : guid
  Name : string
  Nodes : Map<guid, Node>
  Links : Map<guid, Link>
} with
  member x.Context = ContextLookup.Find x.ContextId
  member x.ContainsNode (n:Node) =
    match x.Nodes.TryFind n.Id with
    | None -> false
    | Some n' -> n = n'

  member x.FindNodeType (id:guid) =
     Map.find id x.Context.NodeTypes

  member x.NodeHasLink (n:Node) (s:Slot) =
    if not (x.NodeHasSlot n s) then
      failwith "Slot does not exist on node"

    match s.Mode with
    | In -> Map.exists (fun k l -> l.TargetId = n.Id && l.TargetSlotId = s.Id) x.Links
    | Out -> Map.exists (fun k l -> l.SourceId = n.Id && l.SourceSlotId = s.Id) x.Links

  member x.DeleteLink (l:Link) =
    {x with Links = x.Links.Remove l.Id}

  member x.DeleteNode (n:Node) =
    let nodes = x.Nodes.Remove(n.Id)
    let links = Map.filter (fun _ l -> l.SourceId <> n.Id && l.TargetId <> n.Id) x.Links
    {x with Nodes = nodes; Links = links}

  member x.NodeHasSlot (n:Node) (s:Slot) =
    let nt = x.FindNodeType n.TypeId
    match nt.HasSlot s, n.DynamicType with
    | true , _      -> true
    | false, None   -> false
    | false, Some dt -> dt.HasSlot s

  member x.CreateNode (nt:NodeType) =
    if not (x.Context.HasNodeType nt) then
      failwith "Node type does not exist in context"

    let node = {
      Id = guid.NewGuid()
      TypeId = nt.Id
      Data = null
      Position = Vector3.zero
      DynamicType = None
    }

    {x with Nodes = x.Nodes.Add(node.Id, node)}

  member x.CreateDynamicSlot (n:Node) (s:Slot) =
    if not (x.ContainsNode n) then
      failwith "Canvas does not contain node"

    match n.DynamicType with
    | None ->
      let d = {Id = guid.Empty; Name = ""; SlotsIn = []; SlotsOut = [];}
      x.CreateDynamicSlot {n with DynamicType = Some d} s

    | Some d ->
      let d =
        match s.Mode with
        | In -> {d with SlotsIn = s :: d.SlotsIn}
        | Out -> {d with SlotsOut = s :: d.SlotsOut}

      let n = {n with DynamicType = Some d}
      {x with Nodes = x.Nodes.Remove(n.Id).Add(n.Id, n)}

  member x.CreateLink (source:Node, target:Node, sourceSlot:Slot, targetSlot:Slot) =
    if not (x.ContainsNode source) then
      failwith "Canvas does not contain source node"

    if not (x.ContainsNode target) then
      failwith "Canvas does not contain target node"

    if source.Id = target.Id then
      failwith "Can't connect a node to iself"

    if not (x.NodeHasSlot source sourceSlot) then
      failwith "Slot does not exist on source"

    if not (x.NodeHasSlot target targetSlot) then
      failwith "Slot does not exist on target"

    if sourceSlot.TypeId <> targetSlot.TypeId then
      failwith "Source and target slots dont have the same type"

    if sourceSlot.Mode <> SlotMode.Out then
      failwith "Source slot is not an OUT slot"

    if targetSlot.Mode <> SlotMode.In then
      failwith "Target slot is not an IN slot"

    if (x.NodeHasLink source sourceSlot) && not sourceSlot.AllowMultiple then
      failwith "Source slot is already connected somewhere"

    if (x.NodeHasLink target targetSlot) && not targetSlot.AllowMultiple  then
      failwith "Target slot is already connected somewhere"

    let link = {
      Id = guid.NewGuid()
      Data = null
      SourceId = source.Id
      SourceSlotId = sourceSlot.Id
      TargetId = target.Id
      TargetSlotId = targetSlot.Id
    }

    {x with Links = x.Links.Add(link.Id, link)}

type NodeTypeCreator (context : Context ref, id : guid, name : string) =
  let nodeType = ref { Id = id; Name = name; SlotsIn = []; SlotsOut = [] }

  member x.CreateSlot (id : guid) (mode : SlotMode) (name : string) (dt : DataType) =
    if not ((!context).HasDataType dt) then
      failwith "Canvas type does not contain the data type"

    nodeType := (!nodeType).CreateSlot id mode name dt

  interface System.IDisposable with
    member x.Dispose() =
      context := (!context).AddNodeType !nodeType
      nodeType := Unchecked.defaultof<NodeType>

type ContextCreator (id : guid, name : string) =
  let context = ref { Id = id; Name = name; DataTypes = Map.empty; NodeTypes = Map.empty }

  member x.CreateDataType (id : guid) (name : string) (clr : Color) =
    let dt = { Id = id; Name = name; Color = clr}
    context := (!context).AddDataType dt
    dt

  member x.CreateNodeType (id : guid) (name : string) =
    new NodeTypeCreator(context, id, name)

  member x.FindDataType (id : guid) =
    (!context).FindDataType id

  interface System.IDisposable with
    member x.Dispose() =
      ContextLookup.Register !context
      context := Unchecked.defaultof<Context>