(defun get-xpath-node (node path)
  (let* ((parsed-path (xpath:parse-xpath path))
         (compiled-path (xpath:compile-xpath parsed-path *entrez-environment*)))
    (funcall compiled-path (xpath::make-context node))))

(defparameter *gbinterval-path* (parse-and-compile-path "GBFeature_intervals/GBInterval"))
(defparameter *gbinterval-from-path* (parse-and-compile-path "GBInterval_from/text()"))
(defparameter *gbinterval-to-path* (parse-and-compile-path "GBInterval_to/text()"))

(defun get-gbseq-feature-ranges (node)
  (mapcar
   (lambda (interval)
     (let ((from (car
                  (xpath::force
                   (xpath::pipe-of
                    (funcall *gbinterval-from-path* (xpath::make-context interval))))))
           (to (car
                (xpath::force
                 (xpath::pipe-of
                  (funcall *gbinterval-to-path* (xpath::make-context interval)))))))
       (when (and from to)
         (let ((from (1- (parse-integer (xpath::get-node-text from))))
               (to (1- (parse-integer (xpath::get-node-text to)))))
           (let ((alpha-range (make-instance 'bio:range :start from :end to))
                 (beta-range (make-instance 'bio:range :start 0 :end (- to from))))
             (cons alpha-range beta-range))))))
   (xpath::force
    (xpath::pipe-of
     (funcall *gbinterval-path* (xpath::make-context node))))))

(defun get-gbseq-feature-types (node)
  (let ((features
         (get-xpath-node
          node
          "GBSeq_feature-table/GBFeature/GBFeature_key/text()")))
    features))

(defun parse-gbseq-dom (node)
  (let ((moltype
         (get-xpath-node-text
          node
          (concatenate 'string "GBSeq_moltype/text()"))))
    (let ((obj (make-instance
                (cond
                  ((member moltype '("mRNA" "tRNA" "RNA") :test 'equal) 'bio:adjustable-rna-sequence)
                  ((equal moltype "DNA") 'bio:adjustable-dna-sequence)
                  ((equal moltype "AA") 'bio:adjustable-aa-sequence)
                  (t 'bio:simple-sequence)))))
      (let ((gbseq-locus
             (get-xpath-node-text
              node
              (concatenate 'string "GBSeq_locus/text()"))))
        (when gbseq-locus
          (push (make-instance 'bio:identifier :id gbseq-locus :type "locus")
                (bio:identifiers obj))))
      (let ((gbseq-sequence
             (get-xpath-node-text
              node
              (concatenate 'string "GBSeq_sequence/text()"))))
        (when gbseq-sequence
          (setf (bio:residues-string obj) gbseq-sequence)))
      (let ((feature-nodes (get-gbseq-feature-nodes node)))
        (mapcar
         (lambda (feat)
           (let ((feature-class
                  (feature-annotation-type
                   (get-gbseq-feature-type feat)))
                 (feature-ranges (get-gbseq-feature-ranges feat)))
             (when (and feature-class feature-ranges)
               (mapcar
                (lambda (range-pair)
                  (destructuring-bind (alpha-range . beta-range)
                      range-pair
                    (let* ((annot (make-instance
                                   feature-class
                                   :length (bio::range-end beta-range)))
                           (align (make-instance
                                   'bio:simple-pairwise-alignment
                                   :alpha-sequence obj :alpha-range alpha-range
                                   :beta-sequence annot :beta-range beta-range)))
                      (push align (bio:annotations obj)))))
                       feature-ranges))))
         (xpath::force (xpath::pipe-of feature-nodes))))
      obj)))

(defun parse-gbset-dom (node)
  (let ((set (make-instance 'bio:gene-set)))
    (let ((gb-seqs
           (xpath::force
            (xpath::pipe-of
             (get-xpath-node
              node
              (concatenate 'string "GBSet/GBSeq"))))))
      (setf (bio:genes set)
            (mapcar #'parse-gbseq-dom gb-seqs)))
    set))

(defparameter *entrez-environment* (make-entrez-environment))

(defun parse-and-compile-path (path)
  (let ((parsed-path (xpath:parse-xpath path)))
    (xpath:compile-xpath parsed-path *entrez-environment*)))

(defun get-xpath-node (node path)
  (let* ((parsed-path (xpath:parse-xpath path))
         (compiled-path (xpath:compile-xpath parsed-path *entrez-environment*)))
    (funcall compiled-path (xpath::make-context node))))

(defun xpath-node-text (node)
  (xpath::get-node-text
   (car (xpath::force (xpath::pipe-of node)))))

(defun get-xpath-node-text (node path)
  (xpath-node-text (get-xpath-node node path)))