scratch.nim

import macros, strutils, sequtils

macro isHandle*(t: typed): bool =
  let tpe = t.getTypeImpl
  if tpe.kind != nnkDistinctTy:
    echo "not distinct"
    result = newLit(false)
  elif tpe[0] != bindSym"int":
    echo "not an int"
    result = newLit(false)
  else:
    result = newLit(true)

type
  HandleType* = concept x
    x.isHandle

proc `==`*(a,b: HandleType): bool =
  int(a) == int(b)

proc `$`*(arg: HandleType): string =
  $(int(arg))

macro require(a : bool): untyped =
  let strlit = newLit(a.repr & " failed")
  quote do:
    if not `a`:
      error(`strLit` & $`a`)

proc new[T: object](value: var T): void =
  ## generic ``new`` for objects that contain seq types
  ## of `x` and `y`.
  ## when nim defauts for seq values are not invalid
  ## sequences anymore, this should not be required anymore
  for field in fields(value):
    when field is seq:
      field.newSeq(0)

proc newObjectTypeDefinition(sym: NimNode): NimNode =
  nnkTypeDef.newTree(
    sym,
    newEmptyNode(),
    nnkObjectTy.newTree(
      newEmptyNode(),
      newEmptyNode(),
      nnkRecList.newTree()
    )
  )

type
  ConnectivityKind = enum
    ckOne
    ckAny

proc newConnectivityWalkerProcs(srcRefType, dstRefType, connSeqIdent, connFieldIdent: NimNode, conKind: ConnectivityKind): NimNode =
  var nameStr = $dstRefType.ident
  nameStr.removeSuffix("Ref")

  let goProcIdent = ident("go" & nameStr)

  if conKind == ckOne:
    result = quote do:
      proc `goProcIdent`*(arg: `srcRefType`): `dstRefType` =
        `dstRefType`(mesh: arg.mesh, handle: arg.mesh.`connSeqIdent`[arg.handle.int].`connFieldIdent`)

  else:
    let
      numProcIdent       = ident("num" & nameStr)
      walkProcIdent      = ident("walk" & nameStr)
      walkIndexProcIdent = ident("walkIndex" & nameStr)

    result = quote do:
      proc `numProcIdent`*(arg: `srcRefType`): Natural =
        arg.mesh.publicationConnections[arg.handle.int].`connFieldIdent`.len

      proc `goProcIdent`*(arg: `srcRefType`; index: Natural): `dstRefType` =
        `dstRefType`(mesh: arg.mesh, handle: arg.mesh.publicationConnections[arg.handle.int].`connFieldIdent`[index])

      iterator `walkProcIdent`*(arg: `srcRefType`): `dstRefType` =
        for handle in arg.mesh.publicationConnections[arg.handle.int].`connFieldIdent`:
          yield `dstRefType`(mesh: arg.mesh, handle: handle)

      iterator `walkIndexProcIdent`*(arg: `srcRefType`): tuple[key: int, val: `dstRefType`] =
        for i, handle in arg.mesh.publicationConnections[arg.handle.int].`connFieldIdent`:
          yield (key:i, val: `dstRefType`(mesh: arg.mesh, handle: handle))

proc newConnectivityIdentDefs(sym: NimNode, conKind: ConnectivityKind): NimNode =
  var nameStr = $sym.ident
  nameStr[0] = nameStr[0].toLowerAscii
  nameStr.removeSuffix "Handle"

  let typ = if conKind == ckOne: sym else: nnkBracketExpr.newTree( ident"seq", sym )

  nnkIdentDefs.newTree(
     ident(nameStr),
     typ,
     newEmptyNode()
  )

proc newConnectProc(graphType, leftHandleType, rightHandleType:NimNode; conKindL, conKindR: ConnectivityKind): NimNode =
  ## TODO not implemented yet
  #echo "####################"
  #echo graphType.treeRepr
  #echo leftHandleType.treeRepr
  #echo rightHandleType.treeRepr
  #echo conKindL, conKindR

  let graph = genSym(nskParam, "graph")
  let lh    = genSym(nskParam, "lh")
  let rh    = genSym(nskParam, "rh")

  var fieldNameL = $leftHandleType.ident
  var fieldNameR = $rightHandleType.ident
  fieldNameL[0] = fieldNameL[0].toLowerAscii
  fieldNameR[0] = fieldNameR[0].toLowerAscii
  fieldNameL.removeSuffix "Handle"
  fieldNameR.removeSuffix "Handle"
  let
    fieldL = ident(fieldNameL)
    fieldR = ident(fieldNameR)

  var asgn1, asgn2: NimNode
  if conKindR == ckAny:
    asgn1 = quote do:
      `graph`.conn(`lh`).`fieldR`.add `rh`
  else:
    asgn1 = quote do:
      `graph`.conn(`lh`).`fieldR` = `rh`

  if conKindL == ckAny:
    asgn2 = quote do:
      `graph`.conn(`rh`).`fieldL`.add `lh`
  else:
    asgn2 = quote do:
      `graph`.conn(`rh`).`fieldL` = `lh`

  result = quote do:
    proc connect*(`graph`: var `graphType`; `lh`: `leftHandleType`; `rh`: `rightHandleType`): void =
      `asgn1`
      `asgn2`

macro graphDsl*(graphTypeIdent,arg: untyped): untyped =
  graphTypeIdent.expectKind nnkIdent

  var debug: bool = false
  var nodeTypesStmtList: NimNode
  var connectivityStmtList: NimNode

  for section in arg:
    section.expectKind({nnkIdent, nnkCall})
    if section.kind == nnkCall and section[0] == ident"nodeTypes":
      nodeTypesStmtList = section[1]
      nodeTypesStmtList.expectKind nnkStmtList
    elif section.kind == nnkCall and section[0] == ident"connectivity":
      connectivityStmtList = section[1]
      connectivityStmtList.expectKind nnkStmtList
    elif section.kind == nnkIdent:
      if section == ident"debug":
        debug = true
      else:
        error "unknown identifier, did you mean debug?", section
    else:
      error "expected nodeTypes or connectivity", section

  if nodeTypesStmtList.isNil:
    error "no nodeTypes section", arg
  if connectivityStmtList.isNil:
    error "no connectivit section", arg

  var
    capitalCaseNames =  newSeq[string](0)
    lowerCaseNames   =  newSeq[string](0)
    nodeData         =  newSeq[NimNode](0)

  for node in nodeTypesStmtList:
    var name = $ident(if node.kind == nnkAsgn: node[0] else: node)
    require(name[0].isUpperAscii)
    capitalCaseNames.add name
    name[0] = char(int(name[0]) + 32)
    lowerCaseNames.add name
    nodeData.add(if node.kind == nnkAsgn: node[1] else: node)

  let ConnectivityTypeSymbols  = capitalCaseNames.mapIt ident(it & "Connectivity")            #genSym(nskType, it & "Connectivity")
  let ConnectivityTypes        = ConnectivityTypeSymbols.map newObjectTypeDefinition
  let HandleTypeSymbols        = capitalCaseNames.mapIt ident(it & "Handle")                  #genSym(nskType, it & "Handle")
  let RefTypeSymbols           = capitalCaseNames.mapIt ident(it & "Ref")                     #genSym(nskType, it & "Ref")
  let DataFieldSymbols         = lowerCaseNames.mapIt genSym(nskField, it & "Data")
  let ConnectivityFieldSymbols = lowerCaseNames.mapIt ident(it & "Connections")                                        #genSym(nskField, it & "Connections")


  var typeSection = nnkTypeSection.newTree()

  ##############################################################################
  ################################ graph type ##################################
  ##############################################################################

  var graphTypeRecordList = nnkRecList.newTree()

  proc getRecList(arg: NimNode): NimNode {.compileTime.} =
    arg.expectKind nnkTypeSection
    arg[0].expectKind nnkTypeDef
    arg[0].expectLen 3
    arg[0][2].expectKind nnkObjectTy
    arg[0][2].expectLen 3
    arg[0][2][2].expectKind nnkRecList
    return arg[0][2][2]

  proc getTypeDef(arg: NimNode): NimNode {.compileTime.} =
    arg.expectKind nnkTypeSection
    arg.expectLen 1
    arg[0].expectKind nnkTypeDef
    return arg[0]

  let length = DataFieldSymbols.len
  assert nodeData.len == length
  assert ConnectivityFieldSymbols.len == length
  assert ConnectivityTypeSymbols.len == length

  for i in 0 ..< length:
    let
      dataField = DataFieldSymbols[i]
      node      = nodeData[i]
      connField = ConnectivityFieldSymbols[i]
      connType  = ConnectivityTypeSymbols[i      ]

    let XXX = quote do:
      type XXX = object
        `dataField`*: seq[`node`]
        `connField`: seq[`connType`]

    for rec in XXX.getRecList:
      graphTypeRecordList.add rec

  typeSection.add nnkTypeDef.newTree(
    graphTypeIdent,
    newEmptyNode(),
    nnkObjectTy.newTree(
      newEmptyNode(),
      newEmptyNode(),
      graphTypeRecordList
    )
  )

  var graphProcs = newSeq[NimNode]()

  ##############################################################################
  ############################### handle types #################################
  ##############################################################################

  var accessProcs = newSeq[NimNode](0)

  for ht in HandleTypeSymbols:

    let ast = quote do:
      type `ht`* = distinct int

    if ast.kind == nnkStmtList:
      # change in Nim version
      typeSection.add ast[0][0]
    else:
      typeSection.add ast[0]

  for i in 0 .. high(nodeData):
    let
      ht = HandleTypeSymbols[i]
      connType  = ConnectivityTypeSymbols[i]
      connField = ConnectivityFieldSymbols[i]

    accessProcs.add quote do:
      proc conn(graph: var `graphTypeIdent`; handle: `ht`): var `connType` =
        graph.`connField`[handle.int]


    #  proc data(graph: var `graphTypeIdent`; handle: `ht`): var `dataType` =
    #    graph.`dataField`[handle.int]

  ##############################################################################
  ################################## ref types #################################
  ##############################################################################

  require RefTypeSymbols.len == HandleTypeSymbols.len

  for i in 0 ..< RefTypeSymbols.len:
    let
      refSym = RefTypeSymbols[i]
      handleSym = HandleTypeSymbols[i]

    typeSection.add getTypeDef quote do:
      type `refSym`* = object
        mesh*: ptr `graphTypeIdent`
        handle*: `handleSym`


  ##############################################################################
  ################################# connectivity ###############################
  ##############################################################################

  var connectProcs = newSeq[NimNode](0)
  var walkerProcs  = newSeq[NimNode](0)

  for node in connectivityStmtList:
    var identifiers = newSeq[NimNode](0)

    proc collect(n: NimNode): void =
      case n.kind
      of nnkInfix:
        collect n[1]
        collect n[0]
        collect n[2]
      of {nnkPrefix,nnkCommand}:
        collect n[0]
        collect n[1]
      of {nnkIdent, nnkIntLit}:
        identifiers.add n
      else:
        discard

    collect(node)

    require(identifiers[1] in [ident"*", newLit(1)])
    require(identifiers[2].ident == !"..")
    require(identifiers[3] in [ident"*", newLit(1)])

    let
      identL = identifiers[0]
      identR = identifiers[4]
      indexL = capitalCaseNames.find($identL.ident)
      indexR = capitalCaseNames.find($identR.ident)
      conKindL = if identifiers[1] == newLit(1): ckOne else: ckAny
      conKindR = if identifiers[3] == newLit(1): ckOne else: ckAny

    ConnectivityTypes[indexL][2][2].add newConnectivityIdentDefs(HandleTypeSymbols[indexR], conKindR)
    ConnectivityTypes[indexR][2][2].add newConnectivityIdentDefs(HandleTypeSymbols[indexL], conKindL)

    connectProcs.add newConnectProc(
      graphTypeIdent,
      HandleTypeSymbols[indexL], HandleTypeSymbols[indexR],
      conKindL,                  conKindR
    )

    connectProcs.add newConnectProc(
      graphTypeIdent,
      HandleTypeSymbols[indexR], HandleTypeSymbols[indexL],
      conKindR,                  conKindL
    )

    walkerProcs.add newConnectivityWalkerProcs(RefTypeSymbols[indexL], RefTypeSymbols[indexR], ConnectivityFieldSymbols[indexL], ident(lowerCaseNames[indexR]), conKindR)

  typeSection.add ConnectivityTypes

  ##############################################################################
  ################################ insert procs ################################
  ##############################################################################

  var insertProcs = newSeq[NimNode](0)

  for i in 0 .. high(nodeData):
    let
      connField   = ConnectivityFieldSymbols[i]
      dataField   = DataFieldSymbols[i]
      handleType  = HandleTypeSymbols[i]
      refType     = RefTypeSymbols[i]
      dataType    = nodeData[i]
      connType    = ConnectivityTypeSymbols[i]
      addIdent = ident("add" & capitalCaseNames[i])
      numProcIdent = ident("num" & capitalCaseNames[i])
      iteratorIdent = ident("iterate" & capitalCaseNames[i])


    insertProcs.add(quote do:
      proc `addIdent`*(graph: var `graphTypeIdent`; value: `dataType`): `handleType` =
        graph.`dataField`.add value
        graph.`connField`.add( (var conn : `connType`; conn.new; conn) )
        return `handleType`(high(graph.`dataField`))

      proc `numProcIdent`*(this: `graphTypeIdent`): int = this.`dataField`.len

      iterator `iteratorIdent`*(this: var `graphTypeIdent`): `refType` =
        let thisPtr = this.addr

        for i in 0 ..< this.`dataField`.len:
          yield `refType`(mesh: thisPtr, handle: `handleType`(i))

      proc data*(this: `refType`): var `dataType` =
        this.mesh.`dataField`[this.handle.int]
    )


  let constructorIdent = ident("new" & $graphTypeIdent)
  let resultIdent = ident"result"
  let constructor = quote do:
    proc `constructorIdent`*(): `graphTypeIdent` =
      `resultIdent`.new



  result = newStmtList(typeSection & graphProcs & (constructor & accessProcs) & connectProcs & walkerProcs & insertProcs)

  if debug:
    echo result.repr

import data
export data.saveBinFile
export data.loadBinFile

when isMainModule:
  type
    PublicationData = object
      title*: string
      date*: string
      publisher*: option[string]
      uri*: option[string]
      recordId*: int

    Publisher = string
    Keyword = string

  graphDsl(PublicationGraph):
    debug

    nodeTypes:
      Publication = PublicationData
      Project
      Outlet
      Author
      Keyword
      Publisher
      Institute

    connectivity:
      Publication * .. 1 Publisher
      Publication * .. * Project
      Publication * .. 1 Outlet
      Publication * .. * Author
      Publication * .. 1 Institute
      Publication * .. * Keyword