(use magic-pipes)
(use args)
(use ports)
(use chicken-syntax)
(use sql-de-lite)
(use ssql)
(use alist-lib)

(define (run-output-query filename verbose? sql-query)
  (when verbose? (fprintf (current-error-port) "SQL: ~s\n" sql-query))
  (call-with-database filename
                      (lambda (db)
                        (with-transaction
                         db
                         (lambda ()
                           (let ((stmt (sql db sql-query)))
                             (query
                              (for-each-row (lambda (row)
                                              (data-write (map cons (column-names stmt) row))
                                              (newline)))
                              stmt)))))))

(define (run-input-query filename verbose? sql-query)
  (call-with-database filename
                      (lambda (db)
                        (with-transaction
                         db
                         (lambda ()
                           (let ((stmt (sql db sql-query)))
                             (for-each-input-datum
                              (lambda (input)
                                (unless (list? input)
                                        (error "Input s-expressions must be lists"))
                                (display "(\n")
                                (let ((args
                                       (append
                                        (list
                                         (for-each-row (lambda (row)
                                                         (display " ")
                                                         (data-write (map cons (column-names stmt) row))
                                                         (newline)))
                                         stmt)
                                        input)))
                                  (when verbose? (fprintf (current-error-port) "SQL: ~s ~s\n" sql-query input))
                                  (apply query args))
                                (display ")\n")))))))))

(define (run-insert-query filename verbose? table replace?)
  (call-with-database filename
                      (lambda (db)
                        (with-transaction
                         db
                         (lambda ()
                           (for-each-input-datum
                            (lambda (input)
                              (unless (list? input)
                                      (error "Input s-expressions must be alists"))
                              (let* ((cols (map car input))
                                     (vals (map cdr input))
                                     (sql-query (if replace?
                                                    (sprintf "REPLACE INTO ~a (~a) VALUES (~a)"
                                                             table
                                                             (string-join (map symbol->string cols) ",")
                                                             (string-join (make-list (length vals) "?") ","))
                                                    (ssql->sql #f
                                                               `(insert
                                                                 (into ,table)
                                                                 (columns ,@cols)
                                                                 (values ,(make-vector (length vals) '?))))))
                                     (stmt (sql/transient db sql-query)))
                                (when verbose? (fprintf (current-error-port) "SQL: ~s ~s\n" sql-query vals))
                                (apply exec (cons stmt vals))
                                (data-write (last-insert-rowid db))
                                (newline)))))))))

(define (run-update-query filename verbose? table keys)
  (call-with-database filename
                      (lambda (db)
                        (with-transaction
                         db
                         (lambda ()
                           (for-each-input-datum
                            (lambda (input)
                              (unless (list? input)
                                      (error "Input s-expressions must be alists"))
                              (let* ((key-fields (filter
                                                  (lambda (pair)
                                                    (member (car pair)
                                                            keys))
                                                  input))
                                     (key-vals (map cdr key-fields))
                                     (set-fields (filter
                                                  (lambda (pair)
                                                    (not (member (car pair)
                                                                 keys)))
                                                  input))
                                     (set-vals (map cdr set-fields))
                                     (ssql-query
                                      `(update (table ,(string->symbol table))
                                               (set ,@(map
                                                      (lambda (pair)
                                                        (list (car pair)
                                                              '?))
                                                      set-fields))
                                               (where (and
                                                       ,@(map
                                                          (lambda (pair)
                                                            (list '=
                                                                  (car pair)
                                                                  '?))
                                                          key-fields)))))
                                     (sql-query
                                      (ssql->sql
                                       #f
                                       ssql-query))
                                     (stmt (sql/transient db sql-query)))
                                (when verbose? (fprintf (current-error-port) "SQL: ~s ~s\n" sql-query (append set-vals key-vals)))
                                (apply exec (cons stmt (append set-vals key-vals)))
                                (data-write (change-count db))
                                (newline)))))))))

(receive (options operands before-exprs after-exprs usage)
         (parse-mp-args (command-line-arguments)
                        (list
                         (args:make-option (m mode) (required: "MODE")
                                           "Select the mode (output,input,insert,replace, or update)")
                         (args:make-option (s ssql) #:none
                                           "Parse the query as raw SQL instead of SSQL (input or output mode only)")
                         (args:make-option (v verbose) #:none
                                           "Display the queries as they are run (to standard error)"))
                        "db-path [query|table [keys...]]"
                        "Interact with sqlite databases.

--mode=output (default): Run the supplied query and output an alist
                         of fields for each result row.

  mpsqlite test.sqlite '(select * (from foods))'
  =>
   ((id . 1) (name . \"Fish\"))
   ((id . 2) (name . \"Potato\"))
   ((id . 3) (name . \"Carrot\"))

--mode=input: Run the supplied query once for every input s-expression,
              which must be a list; ?-placedholders in the query are
              replaced with the elements of the list in order. The
              results of each execution are output as a list of rows.

  echo '(1) (2)' |
    mpsqlite -m input test.sqlite '(delete (from foods) (where (= id ?)))'
  =>
   (
   )
   (
   )

--mode=insert: For each input s-expression alist, insert a record into
               the named table, and outputs the rowid of the new record.

 echo '((id . 4) (name . \"Cake\"))' |
  mpsqlite -m insert test.sqlite foods

--mode=replace: For each input s-expression alist, insert a record into
               the named table (or replace a record if one with the same
               primary key fields already exists), and outputs the rowid
               of the new record.

 echo '((id . 4) (name . \"Cheesecake\"))' |
  mpsqlite -m replace test.sqlite foods

--mode=update: For each input s-expression alist, update an existing record
               in the named table. A list of key columns must be supplied after
               the table name on the command line, which are the columns placed
               in the WHERE clause instead of the SET clause. For each input
               s-expression, the number of rows updated is output.

 echo '((id . 3) (name . \"French Carrot\"))' |
  mpsqlite -m update test.sqlite foods id

")
         (unless (>= (length operands) 1)
                 (usage))

         (let* ((sql-filename (car operands))
                (sql-args (cdr operands))
                (sql-mode? (assq 'ssql options))
                (verbose? (assq 'verbose options)))
           (let ((mode
                     (string->symbol
                      (alist-ref options 'mode
                                 (lambda () "output")))))
             (case mode
               ((output)
                (unless (= (length sql-args) 1)
                        (usage))
                (run-output-query sql-filename
                                  verbose?
                                  (if sql-mode?
                                      (car sql-args)
                                      (ssql->sql #f (parse-code (car sql-args))))))
               ((input)
                (unless (= (length sql-args) 1)
                        (usage))
                (run-input-query sql-filename
                                 verbose?
                                 (if sql-mode?
                                     (car sql-args)
                                     (ssql->sql #f (parse-code (car sql-args))))))
               ((insert)
                (when sql-mode? (usage))
                (unless (= (length sql-args) 1)
                        (usage))
                (run-insert-query sql-filename verbose? (car sql-args) #f))
               ((replace)
                (when sql-mode? (usage))
                (unless (= (length sql-args) 1)
                        (usage))
                (run-insert-query sql-filename verbose? (car sql-args) #t))
               ((update)
                (when sql-mode? (usage))
                (unless (>= (length sql-args) 2)
                        (usage))
                (run-update-query sql-filename
                                  verbose?
                                  (car sql-args)
                                  (map string->symbol (cdr sql-args))))
               (else (usage))))))