(define-module (web view markdown)
  #:use-module (json)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:use-module (ice-9 iconv)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 string-fun)
  #:use-module (ice-9 textual-ports)
  #:use-module (ice-9 exceptions)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 rdelim)
  #:use-module (sxml simple)
  #:use-module (web client)
  #:use-module (web uri)
  #:use-module (web request)
  #:use-module (web sxml)
  #:use-module (commonmark)
  #:export (markdown-file->sxml markdown-github->sxml fetch-file
                                fetch-raw-file commit-file))

(define (markdown-file->sxml fn)
  "Parse a local file"
  (commonmark->sxml (call-with-input-file fn
                      get-string-all)))

(define (fetch-raw-file url)
  (receive (response-status response-body)
      (http-request url) response-body))

(define (form-github-raw-url project repo page)
  (string-append "https://raw.githubusercontent.com/"
                 project
                 "/"
                 repo
                 "/master/"
                 (string-join page "/")))

(define (form-github-edit-url project repo page)
  (string-append "https://github.com/"
                 project
                 "/"
                 repo
                 "/edit/master/"
                 (string-join page "/")))

(define (markdown-github->sxml path)
  "Parse a github markdown file that is formed like genenetwork/gn-docs/general/brand/aging/home.md"
  (match-let (((project repo page ...)
               (string-split path #\/)))
             `(div (@ (class "markdown"))
                   ,(commonmark->sxml (fetch-raw-file (pk (form-github-raw-url
                                                           project repo
                                                           (pk page)))))
                   (p (div (@ (class "button-align-right"))
                           (a (@ (href ,(form-github-edit-url project repo
                                                              page))
                                 (role "button")) "edit")))
                   (br)
                   (br))))

(define (fetch-file repo query-path)
  (let* ((abs-path (format #f "~a/~a" repo query-path)))
    (if (file-exists? abs-path)
        (let* ((full-path (canonicalize-path abs-path))
               (content (call-with-input-file full-path
                          get-string-all))
               (commit-sha (get-latest-commit-sha1 repo)))
          `(("file_path" unquote query-path)
            ("content" unquote content)
            ("hash" unquote commit-sha)))
        (throw 'file-error
               (format #f "~a does not exists" abs-path)))))

(define (git-invoke repo-path . args)
  (apply system* "git" "-C" repo-path args))

(define (git-repository? repo-path)
  (let ((data (git-invoke repo-path "rev-parse")))
    (zero? data)))

(define (get-latest-commit-sha1 repo-path)
  (let* ((output-port (open-input-pipe (string-append "git -C " repo-path
                                        " log -n 1 --pretty=format:%H HEAD")))
         (commit-sha (read-line output-port)))
    (close-port output-port) commit-sha))

(define* (commit-file repo
                      file-path
                      content
                      commit-message
                      username
                      email
                      #:optional (prev-commit ""))
  (unless (string=? prev-commit
                    (get-latest-commit-sha1 repo))
    (throw 'system-error
           (format #f
            "Commits do no match.Please pull in latest  changes for current * ~a * and prev * ~a * "
            (get-latest-commit-sha1 repo) prev-commit)))
  (if (git-repository? repo)
      (match (file-exists? (format #f "~a/~a" repo file-path))
        (#t (with-output-to-file (format #f "~a/~a" repo file-path)
              (lambda ()
                (display content)))
         (let* ((git-add-file (git-invoke repo "add" file-path))
                (git-commit-file (git-invoke repo
                                  "commit"
                                  "-m"
                                  commit-message
                                  "-m"
                                  " * Commit made via the GN Markdown Editor"
                                  "--author"
                                  (format #f "~a <~a>" username email)))
                (git-commit-sha (get-latest-commit-sha1 repo)))
           (if (zero? git-commit-file)
               `(("status" . "201")
                 ("message" . "committed file successfully")
                 ("content" . ,content)
                 ("commit_sha" . ,git-commit-sha)
                 ("commit_message" . ,commit-message))
               `(("status" . "200")
                 ("message" . "Nothing to commit, working tree clean")
                 ("commit_sha" . ,git-commit-sha)))))
        (#f (throw 'system-error
                   (format #f "~a File does not exist error" file-path))))
      (throw 'system-error
             (format #f "~a is no a git repo" repo))))