namespace Circuit

open System
open System.Xml
open UnityEngine
open Utils

module Serializer =

  type private doc = XmlDocument
  type private node = XmlNode

  let private parent (n:node) = n.ParentNode
  let private makeTag (doc:doc) (name:string) = doc.CreateElement(name)
  let private makeChild (doc:doc) (name:string) (n:node) = n.AppendChild(doc.CreateElement(name))

  let private makeAttr (doc:doc) (name:string) (value:obj) (n:node) =
    let attr = doc.CreateAttribute(name)
    attr.Value <- value.ToString()
    n.Attributes.Append(attr) |> ignore
    n

  let private makeChildren lst f (n:node) =
    for item in lst do
      n.AppendChild(f item) |> ignore
    n

  let private serializeSlot tag (attr : string -> obj -> node -> node) (s:Slot) =
    tag (if s.Mode = SlotMode.In then "SlotIn" else "SlotOut")
    |> attr "Id" s.Id
    |> attr "TypeId" s.TypeId
    |> attr "Name" s.Name
    |> attr "Mode" (SlotMode.GetName s.Mode)

  let private doc2str (doc:doc) =
    let sb = new Text.StringBuilder(2048)
    let xws = new System.Xml.XmlWriterSettings();
    xws.Indent <- true
    xws.IndentChars <- "  "

    use sw = new System.IO.StringWriter(sb)
    use xw = System.Xml.XmlWriter.Create(sw, xws)

    doc.WriteTo(xw)

    xw.Flush()
    sw.Flush()
    sb.ToString()

  let ContextSerialize (x:Context) =
    let doc = new doc();
    let tag = makeTag doc
    let attr : string -> obj -> node -> node = makeAttr doc
    let child = makeChild doc
    let children = makeChildren

    tag "Context"
      |> attr "Id" x.Id
      |> attr "Name" x.Name
      |> child "DataTypeList"
        |> children x.DataTypes (fun kvp ->
          let dt = kvp.Value
          tag "DataType"
            |> attr "Id" dt.Id
            |> attr "Name" dt.Name
            |> attr "Color" (clr2str dt.Color))
        |> parent
      |> child "NodeTypeList"
        |> children x.NodeTypes (fun kvp ->
          let nt = kvp.Value
          tag "NodeType"
            |> attr "Id" nt.Id
            |> attr "Name" nt.Name
            |> attr "Color" (clr2str nt.Color)
            |> children nt.SlotsIn (serializeSlot tag attr)
            |> children nt.SlotsOut (serializeSlot tag attr))
        |> parent
      |> child "LinkTypeList"
        |> children x.LinkTypes (fun kvp ->
          let lt = kvp.Value
          tag "LinkType"
            |> attr "Id" lt.Id
            |> attr "Name" lt.Name
            |> attr "Color" (clr2str lt.Color))
      |> parent
      |> doc.AppendChild
      |> ignore

    // output document as string
    doc2str doc

  let ContextDeserialize (str:string) =
    let doc = new doc()
    doc.LoadXml str

    let parseGuid (n:node) (attr:string) = new Guid(n.Attributes.[attr].Value)
    let parseId (n:node) = parseGuid n "Id"
    let parseName (n:node) = n.Attributes.["Name"].Value
    let parseColor (n:node) = str2clr n.Attributes.["Color"].Value

    let cc =
      doc.SelectSingleNode "/Context"
        |> (fun n -> new ContextCreator(parseId n, parseName n))

    doc.SelectNodes "/Context/DataTypeList/DataType"
      |> Seq.cast<node>
      |> Seq.iter (fun n -> cc.CreateDataType(parseId n, parseName n, parseColor n) |> ignore)

    doc.SelectNodes "/Context/NodeTypeList/NodeType"
      |> Seq.cast<node>
      |> Seq.iter (fun n ->
        let nt = cc.CreateNodeType(parseId n, parseName n, parseColor n)

        let parseSlot (n:node) =
          let mode = SlotMode.GetValue n.Attributes.["Mode"].Value
          let dt = cc.Context.FindDataType(parseGuid n "TypeId")
          cc.CreateNodeTypeSlot(nt, parseId n, dt, parseName n, mode)

        n.SelectNodes("SlotIn")
         |> Seq.cast<node>
         |> Seq.reverse
         |> Seq.iter parseSlot

        n.SelectNodes("SlotOut")
         |> Seq.cast<node>
         |> Seq.reverse
         |> Seq.iter parseSlot
      )

    doc.SelectNodes "/Context/LinkTypeList/LinkType"
      |> Seq.cast<node>
      |> Seq.iter (fun n -> cc.CreateLinkType(parseId n, parseName n, parseColor n) |> ignore)

    cc

  let CanvasSerialize (x:Canvas) =
    let doc = new doc();
    let tag = makeTag doc
    let attr : string -> obj -> node -> node = makeAttr doc
    let child = makeChild doc
    let children = makeChildren

    tag "Canvas"
      |> attr "Id" x.Id
      |> attr "Name" x.Name
      |> attr "ContextId" x.Context.Id
      |> doc.AppendChild
      |> ignore

    // write document
    doc2str doc