(library (sph storage dg cli)
  (export
    dg-cli
    dg-cli-command-handler
    dg-cli-commands
    dg-cli-export
    dg-cli-import
    dg-cli-server
    dg-cli-stat)
  (import
    (rnrs exceptions)
    (sph)
    (sph alist)
    (sph cli)
    (sph io)
    (sph lang indent-syntax)
    (sph lang scheme)
    (sph list)
    (sph storage dg)
    (sph storage dg export)
    (sph storage dg file)
    (sph storage dg import)
    (sph storage dg server)
    (sph storage dg tag)
    (sph string)
    (only (guile)
      display
      current-output-port
      call-with-output-file
      getenv
      string-join
      string-null?
      string-split)
    (only (sph two) call))

  (define sph-storage-dg-cli-description "program for database administration and utility features")

  (define (dg-cli-import options dg-root)
    (dg-use dg-root
      (alist-bind-and* options (format sources)
        (if (or (eq? (q file-itpn)) (eq? (q file-dot))) (begin (dg-tag-init) (dg-file-init)))
        (alist-bind options
          (config file-add-tags file-has-no-id file-import-tag ignore-extensions run)
          (let*
            ( (add-tags (options-get-string-list options (q add-tags)))
              (c
                (l (txn)
                  (dg-import-files txn (string->symbol format)
                    sources run
                    #:add-tag-strings file-add-tags
                    #:has-no-id file-has-no-id
                    #:import-tag file-import-tag
                    #:ignore-mime-extensions ignore-extensions
                    #:dry-run-port (current-output-port) #:config config))))
            (if run (dg-txn-call-write c) (dg-txn-call-read c)))))))

  (define (dg-cli-export options dg-root)
    (alist-bind options (files mode target)
      (dg-use dg-root (if files (begin (dg-tag-init) (dg-file-init)))
        (dg-txn-call-read
          (l (txn)
            (if files
              (if target
                (begin (dg-export-files txn target #:mode (and mode (string->symbol mode))))
                (raise (q missing-argument-target)))
              (if target (call-with-output-file target (l (port) (dg-export-scm txn port)))
                (dg-export-scm txn (current-output-port)))))))))

  (define (dg-cli-server options dg-root)
    (alist-bind options (address add-env port)
      (dg-use dg-root (dg-server-start #:address address #:port port))))

  (define (dg-cli-client options dg-root)
    (alist-bind options (address port)
      (dg-server-client
        (l (server) (display (string-trim-both (port->string (current-input-port))) server)
          (write (port->datums server) (current-output-port)))
        address port)))

  (define (dg-cli-stat options dg-root) (display-line (string-append "root: " dg-root))
    (let
      ( (stat-info (dg-use dg-root (dg-txn-call-read dg-statistics)))
        (keys
          (list-q id->data left->right data-extern->extern data-intern->id label->left right->left)))
      (each
        (l (dbi data) (display-line dbi)
          (each (l (a) (display "  ") (display (first a)) (display ": ") (display-line (tail a)))
            data))
        keys (alist-select stat-info keys))))

  (define (prepare-actions recreate index-intern index-extern index-relation)
    (filter-map
      (l (use name proc)
        (and use (pair name (if recreate (tail proc) (nullary (dg-txn-call-read (first proc)))))))
      (list index-intern index-extern index-relation)
      (list-q index-intern index-extern index-relation)
      (list (pair dg-index-errors-intern dg-index-recreate-intern)
        (pair dg-index-errors-extern dg-index-recreate-extern)
        (pair dg-index-errors-relation dg-index-recreate-relation))))

  (define (evaluate-actions dg-root recreate actions)
    (dg-use dg-root
      (let
        (success
          (if recreate (every call (map tail actions))
            (let (b (every-map call (map tail actions)))
              (and b (if (alist-ref-q b errors?) (begin (display-line b) #f) #t)))))
        (display-line (if success "success" "failure")))))

  (define (dg-cli-index options dg-root)
    (alist-bind options (recreate index-all index-intern index-extern index-relation)
      (evaluate-actions dg-root recreate
        (prepare-actions recreate (or index-all index-intern)
          (or index-all index-extern) (or index-all index-relation)))))

  (define (options->dg-root a)
    (or (alist-ref-q a dg-root (getenv "DG_ROOT")) (raise (q dg-root-not-set))))

  (define (with-target-port target proc)
    "string/port procedure -> any
     if target is a string, open as file, otherwise current-output-port"
    (if (string-equal? "-" target) (proc (current-output-port)) (call-with-output-file target proc)))

  (define (options-get-string-list options key)
    (let (a (alist-ref options key))
      (if (string? a) (delete-duplicates (remove string-null? (string-split a #\,))) a)))

  (define (string-lines . a) (string-join a "\n"))

  (define (dg-cli-command-handler command options)
    (let (name (first command))
      (or
        ( (string-case name ("export" dg-cli-export)
            ("index" dg-cli-index) ("server" dg-cli-server)
            ("client" dg-cli-client) ("stat" dg-cli-stat) ("import" dg-cli-import) (else #f))
          options (options->dg-root options))
        (dg-cli (list name "--help")))))

  (define-as dg-cli-commands list-qq
    ( ("export") #:description "extract (dump) data"
      ((target) #:required? #f) (mode #:value-required? #t)
      (files #:description
        "save only (sph storage dg file) files with id and period-separated tag-strings as file names in target directory"))
    ( ("import") #:description (unquote "import data")
      ((format sources ...) #:required? #t) (config #:value-required? #t)
      (ignore-extensions) (run)
      (file-add-tags #:value-required? #t) (file-has-no-id)
      (file-import-tag) (file-ignore-mime-extensions))
    ( ("server") #:description
      (unquote
        (string-lines
          "create a server where scheme code can be written to be evaluated with an initialised database"
          "can be used for data transmission between multiple databases locally or over a network"))
      (address #:value-required? #t
        #:description "an ip6/ip4 address or a filesystem path to create a unix server")
      (port #:value-required? #t
        #:description
        (unquote
          (string-append "port number to use if a tcp server is used. default is "
            (number->string dg-server-default-port))))
      (add-env #:value-required? #t
        #:description "a scheme list of module names to additionally load for evaluation"))
    (("client") (address #:value-required? #t) (port #:value-required? #t)) (("stat"))
    ( ("index") #:description
      "validate or recreate the indexes of the database. default is to check all indexes" (recreate)
      (index-all) (index-relation) (index-intern) (index-extern)))

  (define dg-cli
    (cli-create #:description "administration and utility commands"
      #:command-handler dg-cli-command-handler
      #:commands dg-cli-commands
      #:command-options (list-q (dg-root #:value-optional? #t #:type string))
      #:options (list-q ((sub-command argument ...))))))