(pre-define (increment a) (set a (+ 1 a)))
(pre-define (decrement a) (set a (- a 1)))

(pre-include-once
  stdio-h "stdio.h"
  stdlib-h "stdlib.h"
  errno-h "errno.h"
  pthread-h "pthread.h")

(pre-define debug-log? #t)

(sc-include-once
  sph-dg "main/sph-dg"
  sph-dg-lmdb "main/lib/lmdb"
  sph-dg-debug "main/lib/debug"
  sph-one "foreign/sph/one")

(define (dg-ids-reverse source result) (status-t dg-ids-t* dg-ids-t**)
  status-init
  (define ids-temp dg-ids-t*)
  (while source
    (dg-ids-add! (deref result) (dg-ids-first source) ids-temp)
    (set source (dg-ids-rest source)))
  (label exit
    (return status)))

(define (dg-ids-contains? ids id) (boolean dg-ids-t* dg-id-t)
  (while ids
    (if (equal? id (dg-ids-first ids)) (return #t))
    (set ids (dg-ids-rest ids)))
  (return #f))

(define (dg-debug-display-all-relations txn) (status-t MDB-txn*)
  status-init
  (define
    records dg-relation-records-t*
    state dg-relation-read-state-t)
  (set records 0)
  (dg-status-require-read! (dg-relation-select txn 0 0 0 0 0 (address-of state)))
  (dg-status-require-read! (dg-relation-read (address-of state) 0 (address-of records)))
  (printf "all ")
  (dg-relation-selection-destroy (address-of state))
  (dg-debug-display-relation-records records)
  (dg-relation-records-destroy records)
  (label exit
    (return status)))

(pre-define (dg-debug-define-relation-records-contains-at? field)
  (define ((pre-concat dg-debug-relation-records-contains-at_ field _p) records id)
    (boolean dg-relation-records-t* dg-id-t)
    (while records
      (if (equal? id (struct-get (dg-relation-records-first records) field)) (return #t))
      (set records (dg-relation-records-rest records)))
    (return #f)))

(dg-debug-define-relation-records-contains-at? left)
(dg-debug-define-relation-records-contains-at? right)
(dg-debug-define-relation-records-contains-at? label)
(pre-define test-helper-dg-root "/tmp/test-sph-dg")
(pre-define test-helper-path-data (pre-string-concat test-helper-dg-root "/data"))

(pre-define (test-helper-assert description expression)
  (if (not expression)
    (begin
      (printf "%s failed\n" description)
      (status-set-id-goto 1))))

(pre-define (test-helper-filter-ids->reader-suffix-integer left right label ordinal)
  (bit-or (if* left 8 0) (if* right 4 0) (if* label 2 0) (if* ordinal 1 0)))

(pre-define (test-helper-test-one func)
  (printf "%s\n" (pre-stringify func))
  (status-require! (test-helper-dg-reset #f))
  (status-require! (func)))

(define (test-helper-create-ids count result) (status-t b32 dg-ids-t**)
  status-init
  (dg-define-ids ids-temp)
  dg-txn-introduce
  dg-txn-write-begin
  (dg-id-create dg-txn count (address-of ids-temp))
  dg-txn-commit
  ; reverse for sorting that aids debugging. some tests depend on it
  (status-require (dg-ids-reverse ids-temp result))
  (label exit
    (return status)))

(define (test-helper-create-interns count result) (status-t b32 dg-ids-t**)
  status-init
  (define data-element dg-data-t (struct-literal (size dg-size-octets-id) (data 0)))
  (define data-list dg-data-list-t* 0)
  (while count
    (struct-set data-element data (calloc 1 (sizeof dg-ids-t)))
    (set (deref (convert-type (struct-get data-element data) dg-id-t*)) (+ 123 count))
    (set data-list (dg-data-list-add data-list data-element))
    (set count (- count 1)))
  dg-txn-introduce
  dg-txn-write-begin
  (status-require! (dg-intern-ensure dg-txn data-list result))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-helper-default-ordinal-generator state) (dg-ordinal-t b0*)
  (define ordinal-pointer dg-ordinal-t* state)
  (define result dg-ordinal-t (+ 1 (deref ordinal-pointer)))
  (set (deref ordinal-pointer) result)
  (return result))

(define (test-helper-create-relations count-left count-right count-label left right label)
  (status-t b32 b32 b32 dg-ids-t** dg-ids-t** dg-ids-t**)
  status-init
  (status-require! (test-helper-create-ids count-left left))
  (status-require! (test-helper-create-ids count-right right))
  (status-require! (test-helper-create-ids count-label label))
  (define ordinal-state-value dg-ordinal-t 0)
  dg-txn-introduce
  dg-txn-write-begin
  (status-require!
    (dg-relation-ensure
      dg-txn
      (deref left)
      (deref right)
      (deref label) test-helper-default-ordinal-generator (address-of ordinal-state-value)))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (test-helper-calculate-relation-count left-count right-count label-count) (b32 b32 b32 b32)
  (return (* left-count right-count label-count)))

(define (test-helper-calculate-relation-count-from-ids left right label)
  (b32 dg-ids-t* dg-ids-t* dg-ids-t*)
  (return
    (test-helper-calculate-relation-count
      (dg-ids-length left) (dg-ids-length right) (dg-ids-length label))))

(define
  (test-helper-estimate-relation-read-result-count left-count right-count label-count ordinal)
  (b32 b32 b32 b32 dg-ordinal-match-data-t*)
  ;assumes linearly incremented ordinal integers starting at 1 and queries for all or no ids
  (define count b32 (* left-count right-count label-count))
  (define max b32)
  (define min b32)
  (if ordinal
    (begin
      (set
        min (if* (struct-pointer-get ordinal min) (- (struct-pointer-get ordinal min) 1) 0)
        max (struct-pointer-get ordinal max))
      (if* (> max count) (set max count)))
    (set
      min 0
      max count))
  (return (- count min (- count max))))

(define
  (test-helper-estimate-relation-read-btree-entry-count
    existing-left-count existing-right-count existing-label-count ordinal)
  (b32 b32 b32 b32 dg-ordinal-match-data-t*)
  ;calculates the number of btree entries affected by a relation read or delete.
  ;assumes linearly incremented ordinal integers starting at 1 and queries for all or no ids
  (define ordinal-min b32 0)
  (define ordinal-max b32 0)
  (if ordinal
    (set
      ordinal-min (struct-pointer-get ordinal min)
      ordinal-max (struct-pointer-get ordinal max)))
  (define label-left-count b32 0)
  (define left-right-count b32 0)
  (define right-left-count b32 0)
  ;test relation ordinals currently start at one
  (define ordinal-value b32 1)
  (define left-count b32 0)
  (define right-count b32 0)
  (define label-count b32 0)
  ;the number of relations is not proportional to the number of entries in label->left.
  ;use a process similar to relation creation to correctly calculate label->left and ordinal dependent entries
  (while (< label-count existing-label-count)
    (while (< left-count existing-left-count)
      (if (and (<= ordinal-value ordinal-max) (>= ordinal-value ordinal-min))
        (increment label-left-count))
      (while (< right-count existing-right-count)
        (if (and (<= ordinal-value ordinal-max) (>= ordinal-value ordinal-min))
          (begin
            (increment ordinal-value)
            (increment left-right-count)
            (increment right-left-count)))
        (increment right-count))
      (increment left-count))
    (increment label-count))
  (return (+ left-right-count right-left-count label-left-count)))

(define (test-helper-ids-add-new-ids ids-old result) (status-t dg-ids-t* dg-ids-t**)
  ;interleave new ids starting from half the given ids, and add another half of only new ids to the end
  ;approximately like this: 1 1 1 1 -> 1 1 2 1 2 1 2 2
  ;this is to ensure that we have a subsequent existing ids/new-ids and alternating existing/new ids
  status-init
  (dg-define-ids ids-new)
  (set (deref result) 0)
  (status-require! (test-helper-create-ids (dg-ids-length ids-old) (address-of ids-new)))
  (define target-count b32 (* 2 (dg-ids-length ids-old)))
  (define start-mixed b32 (/ target-count 4))
  (define start-new b32 (- target-count start-mixed))
  (define count b32 0)
  (while (< count target-count)
    (if (< count start-mixed)
      (begin
        (set (deref result) (dg-ids-add (deref result) (dg-ids-first ids-old)))
        (set ids-old (dg-ids-rest ids-old)))
      (if (< count start-new)
        (if (bit-and 1 count)
          (begin
            (set (deref result) (dg-ids-add (deref result) (dg-ids-first ids-old)))
            (set ids-old (dg-ids-rest ids-old)))
          (begin
            (set (deref result) (dg-ids-add (deref result) (dg-ids-first ids-new)))
            (set ids-new (dg-ids-rest ids-new))))
        (begin
          (set (deref result) (dg-ids-add (deref result) (dg-ids-first ids-new)))
          (set ids-new (dg-ids-rest ids-new)))))
    (set count (+ 1 count)))
  (label exit
    (return status)))

(define (test-helper-reader-suffix-integer->string a) (b8* b8)
  (define result b8* (malloc 40))
  (array-set-index
    result
    0
    (if* (bit-and 8 a) #\1 #\0)
    1 (if* (bit-and 4 a) #\1 #\0) 2 (if* (bit-and 2 a) #\1 #\0) 3 (if* (bit-and 1 a) #\1 #\0) 4 0)
  (return result))

(define (test-helper-dg-reset re-use) (status-t boolean)
  status-init
  (if dg-initialised (dg-exit))
  (if (and (not re-use) (file-exists? test-helper-path-data))
    (status-set-id (system (pre-string-concat "rm " test-helper-path-data))))
  status-require
  (status-require! (dg-init test-helper-dg-root 0))
  (label exit
    (return status)))