(sc-include-once
  sph-dg "main/sph-dg")

(pre-include-once
  pthread-h "pthread.h")

(define
  dbi-left->right MDB-dbi
  dbi-right->left MDB-dbi
  dbi-label->left MDB-dbi
  dbi-id->data MDB-dbi
  dbi-data-extern->extern MDB-dbi
  dbi-data-intern->id MDB-dbi)

(pre-define (dg-relation-key-equal? a b)
  (and
    (dg-id-equal? (array-get a 0) (array-get b 0)) (dg-id-equal? (array-get a 1) (array-get b 1))))

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

(pre-define (dg-error-log pattern ...)
  (fprintf stderr (pre-string-concat "%s:%d error: " pattern "\n") __func__ __LINE__ __VA_ARGS__))

(pre-define reduce-count (set count (- count 1)))
(pre-define stop-if-count-zero (if (= 0 count) (goto exit)))
(pre-define (optional-count count) (if* (= 0 count) UINT32_MAX count))

(define (dg-ids->set a result) (status-t dg-ids-t* imht-set-t**)
  status-init
  (if (not (imht-set-create (dg-ids-length a) result)) (dg-status-set-id-goto dg-status-id-memory))
  (while a
    (imht-set-add (deref result) (dg-ids-first a))
    (set a (dg-ids-rest a)))
  (label exit
    (return status)))

(define (dg-init-options-set-defaults a) (dg-init-options-t dg-init-options-t*)
  (struct-set (deref a) read-only? 0)
  (struct-set (deref a) maximum-size-octets 17179869183)
  (struct-set (deref a) maximum-reader-count 65535)
  (struct-set (deref a) env-open-flags 0)
  (struct-set (deref a) filesystem-has-ordered-writes? 1)
  (struct-set (deref a) file-permissions 384))

(define (dg-init-env-open-flags options) (b32 dg-init-options-t)
  (return
    (if* options.env-open-flags
      options.env-open-flags
      (bit-or
        MDB-NOSUBDIR
        MDB-WRITEMAP
        (if* options.read-only? MDB-RDONLY 0)
        (if* options.filesystem-has-ordered-writes? MDB-MAPASYNC 0)))))

(define (dg-init-root-path-prepare a file-permissions) (status-t b8* b16)
  status-init
  (if (not a) (dg-status-set-id-goto dg-status-id-missing-argument-dg-root))
  (if (not (ensure-directory-structure dg-root (bit-or 73 file-permissions)))
    (dg-status-set-id-goto dg-status-id-path-not-accessible-dg-root))
  (label exit
    (return status)))

(pre-define (dg-select-ensure-offset state offset reader)
  (if offset
    (begin
      (struct-pointer-set state
        options (bit-or dg-read-option-skip (struct-pointer-get state options)))
      (set status (reader state offset 0))
      (if (not dg-mdb-status-success?) dg-mdb-status-require-notfound)
      (struct-pointer-set state
        options (bit-xor dg-read-option-skip (struct-pointer-get state options))))))

(define (dg-statistics txn result) (status-t dg-txn-t* dg-statistics-t*)
  "expects an allocated dg-statistics-t"
  status-init
  (pre-let
    ( (result-set dbi-name)
      (dg-mdb-status-require!
        (mdb-stat txn (pre-concat dbi- dbi-name) (address-of (struct-get (deref result) dbi-name)))))
    (result-set id->data)
    (result-set data-intern->id)
    (result-set data-extern->extern)
    (result-set left->right) (result-set right->left) (result-set label->left))
  (label exit
    (return status)))

(sc-include-once
  sph-dg-relation "relation"
  sph-dg-node "node"
  sph-dg-index "index")

(define (dg-init dg-root-argument options-pointer) (status-t b8* dg-init-options-t*)
  status-init
  (set dg-root (string-clone dg-root-argument))
  (if (not dg-root) (dg-status-set-id-goto dg-status-id-memory))
  (define options dg-init-options-t)
  (if options-pointer
    (set options (deref options-pointer)) (dg-init-options-set-defaults (address-of options)))
  (if dg-initialised (return status))
  dg-txn-introduce
  (define path-database b8* 0)
  (status-require! (dg-init-root-path-prepare dg-root options.file-permissions))
  (set path-database (string-append dg-root "/data"))
  (if (not path-database) (dg-status-set-id-goto dg-status-id-memory))
  (dg-mdb-status-require! (mdb-env-create (address-of dg-mdb-env)))
  (dg-mdb-status-require! (mdb-env-set-maxdbs dg-mdb-env 16))
  (dg-mdb-status-require! (mdb-env-set-mapsize dg-mdb-env options.maximum-size-octets))
  (dg-mdb-status-require! (mdb-env-set-maxreaders dg-mdb-env options.maximum-reader-count))
  (dg-mdb-status-require!
    (mdb-env-open
      dg-mdb-env path-database (dg-init-env-open-flags options) options.file-permissions))
  (define db-options b32 MDB-CREATE)
  dg-txn-write-begin
  (dg-mdb-status-require! (mdb-dbi-open dg-txn "id->data" db-options (address-of dbi-id->data)))
  (dg-mdb-status-require!
    (mdb-dbi-open dg-txn "data-intern->id" db-options (address-of dbi-data-intern->id)))
  (dg-mdb-status-require!
    (mdb-set-compare dg-txn dbi-id->data (convert-type dg-mdb-compare-id MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-compare dg-txn dbi-data-intern->id (convert-type dg-mdb-compare-data MDB-cmp-func*)))
  (set db-options (bit-or MDB-CREATE MDB-DUPSORT MDB-DUPFIXED))
  (dg-mdb-status-require!
    (mdb-dbi-open dg-txn "left->right" db-options (address-of dbi-left->right)))
  (dg-mdb-status-require!
    (mdb-dbi-open dg-txn "right->left" db-options (address-of dbi-right->left)))
  (dg-mdb-status-require!
    (mdb-dbi-open dg-txn "label->left" db-options (address-of dbi-label->left)))
  (dg-mdb-status-require!
    (mdb-dbi-open
      dg-txn
      "data-extern->extern" (bit-xor MDB-DUPFIXED db-options) (address-of dbi-data-extern->extern)))
  (dg-mdb-status-require!
    (mdb-set-compare
      dg-txn dbi-left->right (convert-type dg-mdb-compare-relation-key MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-compare
      dg-txn dbi-right->left (convert-type dg-mdb-compare-relation-key MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-compare dg-txn dbi-label->left (convert-type dg-mdb-compare-id MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-compare
      dg-txn dbi-data-extern->extern (convert-type dg-mdb-compare-data MDB-cmp-func*)))
  ; the id of the relation itself that is stored at the end of the value is ignored when comparing
  (dg-mdb-status-require!
    (mdb-set-dupsort
      dg-txn dbi-left->right (convert-type dg-mdb-compare-relation-data MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-dupsort dg-txn dbi-right->left (convert-type dg-mdb-compare-id MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-dupsort dg-txn dbi-label->left (convert-type dg-mdb-compare-id MDB-cmp-func*)))
  (dg-mdb-status-require!
    (mdb-set-dupsort dg-txn dbi-data-extern->extern (convert-type dg-mdb-compare-id MDB-cmp-func*)))
  (status-require! (id-next-initialise dg-txn))
  dg-txn-commit
  dg-mdb-reset-val-null
  (set dg-initialised #t)
  (label exit
    (if status-failure?
      (begin
        (mdb-env-close dg-mdb-env)
        (if dg-txn dg-txn-abort)))
    (free path-database)
    (return status)))

(define (dg-exit) b0
  (mdb-dbi-close dg-mdb-env dbi-id->data)
  (mdb-dbi-close dg-mdb-env dbi-left->right)
  (mdb-dbi-close dg-mdb-env dbi-right->left)
  (mdb-dbi-close dg-mdb-env dbi-data-intern->id)
  (mdb-dbi-close dg-mdb-env dbi-data-extern->extern)
  (mdb-env-close dg-mdb-env)
  (pthread-mutex-destroy (address-of id-next-mutex))
  (free dg-root)
  (set dg-initialised #f))