Fetches a quickscript at a given url and adds it to the library

url2script.rkt

#lang racket/base

;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;;          [MIT license](http://opensource.org/licenses/MIT) at your option.

(require quickscript
         quickscript/base
         quickscript/library
         racket/class
         racket/file
         racket/match
         racket/port
         racket/path
         racket/string
         racket/gui/base
         net/url)

(script-help-string "Fetches a quickscript at a given url and adds it to the library.")

(define dir user-script-dir)

(define url2script-submod-name 'url2script-info)

;; Will be in quickscript/utils at some point
(define (smart-open-file drfr f)
  (cond
    [(not (file-exists? f))
     (message-box "Error"
                  (format "File not found: ~a" f)
                  drfr
                  '(ok stop))
     #f]
    [(send drfr still-untouched?)
     (send drfr change-to-file f)
     #t]
    [(send drfr find-matching-tab f)
     =>
     (λ (tab)
       (send drfr change-to-tab tab)
       #t)]
    [else
     (send drfr open-in-new-tab f)
     #t]))

(define (parse-url str)
  (match str
    ; We can extract the filename
    ; "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e26/letterfall.rkt"
    [(regexp #px"^https://gist\\.github(?:usercontent|)\\.com/[^/]+/[0-9a-f]+/raw/[0-9a-f]+/([^/]+)$"
                 (list _ filename))
     (values str filename)]
    ; "https://gist.githubusercontent.com/Metaxal/4449e059959da9f344f83c7e628ad9af/raw"
    ; "https://pastebin.com/raw/EMfcc5zs"
    [(or (regexp #px"^https://gist\\.github(?:usercontent|).com/[^/]+/[0-9a-f]+/raw$")
         (regexp #px"^https://gitlab\\.com/snippets/[0-9]+/raw$")
         (regexp #px"^http://pasterack\\.org/pastes/[0-9]+/raw$")
         (regexp #px"^https://pastebin.com/raw/[0-9a-zA-Z]+$"))
     (values str #f)]
    ; "https://gist.githubusercontent.com/Metaxal/4449e059959da9f344f83c7e628ad9af"
    ; "https://gitlab.com/snippets/1997854"
    ; "http://pasterack.org/pastes/8953"
    [(or (regexp #px"^https://gist\\.github(?:usercontent|)\\.com/[^/]+/[0-9a-f]+$")
         (regexp #px"^https://gitlab\\.com/snippets/[0-9]+$")
         (regexp #px"^http://pasterack\\.org/pastes/[0-9]+$"))
     (values (string-append str "/raw") #f)]
    ; "https://pastebin.com/EMfcc5zs"
    [(regexp #px"^https://pastebin.com/([0-9a-zA-Z]+)$" (list _ name))
     (values (string-append "https://pastebin.com/raw/" name) #f)]
    ; Any other kind of url, we assume a link to a raw file
    [else (values str #f)]))

;; TODO: check it is indeed a (valid?) quickscript
(define (get-text-at-url aurl)
  (port->string (get-pure-port (string->url aurl) #:redirections 10)
                #:close? #t))

;; Notice: Does not ask to replace (should be done prior).
;; Doesn't add a submodule if one already exists.
;; Allows the designer to give the default file name to save the script.
(define (write-script fout text aurl #:filename [filename (file-name-from-path fout)])
  ;; A s-exp test would be better… or maybe even trying to read the info?
  (define submod-first-line
    (string-append "(module " (symbol->string url2script-submod-name) " racket/base"))
  (define has-submod? (string-contains? text submod-first-line))
  
  (display-to-file
         #:exists 'replace
         (string-append
          text
          (if has-submod?
            ""
            (string-append
             "\n"
             submod-first-line
             "
  (provide filename url)
  (define filename " (format "~s" (and filename (path->string filename))) ")
  (define url " (format "~s" aurl) "))
")))
         fout))

(define (get-submod-url f)
  (parameterize ([current-namespace (make-base-empty-namespace)])
    (dynamic-require `(submod (file ,(path->string f)) ,url2script-submod-name)
                     'url
                     (λ () #f))))

(define (get-submod-filename f)
  (parameterize ([current-namespace (make-base-empty-namespace)])
    (dynamic-require `(submod (file ,(path->string f)) ,url2script-submod-name)
                     'filename
                     (λ () #f))))

;; Returns a replacement string for the selected string `selection`
;; ("" if no text is selected), or `#f` to leave the selection as is.
(define-script url2script
  #:label "Fetch script…"
  #:menu-path ("url2script")
  (λ (selection #:frame frame)
    #;(make-directory* dir)
    #;(add-third-party-script-directory! dir)
    (define str (get-text-from-user
                 "url2script"
                 "Enter url to gist, gitlab snippet or pasterack, or to a raw racket file:"))
    (when str
      ; at a special commit, with the name at the end, which we could extract
      (define-values (aurl maybe-filename) (parse-url str))
      
      (define text (get-text-at-url aurl))
      (define ftmp (make-temporary-file))
      ; Write a first time to maybe-write and read the submod infos
      (write-script ftmp text aurl #:filename maybe-filename)
      (define filename (get-submod-filename ftmp))

      (define fout (put-file "url2script: Save script as…"
                            frame
                            dir
                            (or filename ".rkt")
                            ".rkt"
                            '()
                            '(("Racket source" "*.rkt")
                              ("Any" "*.*"))))

      (when fout
        (write-script fout text str)
        (smart-open-file frame fout))
      #f)))

(module+ test
  (require rackunit)

  (let ()
    (define f (make-temporary-file))
    (define aurl "https://this.is.your/home/now")
    (write-script f "#lang racket/base\n" aurl)
    (check-equal? (get-submod-url f)
                  aurl))  

  (define (test-parse-url url)
    (call-with-values (λ () (parse-url url)) list))
  
  (check-equal?
   (test-parse-url "https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b")
   '("https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw"
     #f))
  (check-equal?
   (test-parse-url "https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw")
   '("https://gist.github.com/Metaxal/f5ea8e94b802eac947fe9ea72870624b/raw"
     #f))

  (check-equal?
   (test-parse-url "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e/letterfall.rkt")
   (list "https://gist.githubusercontent.com/Metaxal/4449e/raw/342e/letterfall.rkt"
         "letterfall.rkt")))

;; Updates a script that was downloaded with url2script.
(define-script update-script
  #:label "Update current script"
  #:menu-path ("url2script")
  (λ (selection #:file f #:frame drfr)
    (when f
      (define submod-url (get-submod-url f))
        
      (cond
        [submod-url
         (define-values (aurl _name) (parse-url submod-url))
         (define text (get-text-at-url aurl))
         (define ok?
           (message-box "Attention"
                        "This will rewrite the current file. Continue?"
                        #f
                        '(ok-cancel caution)))
         (when ok?
           (write-script f text aurl)
           (when drfr (send drfr revert)))]
        [else
         (message-box
          "Error"
          "Unable to find original url. Script may not have been downloaded with url2script."
          #f
          '(ok stop))]))
    #f))

(module url2script-info racket/base
  (provide url filename)
  (define filename "url2script.rkt")
  (define url "https://gist.githubusercontent.com/Metaxal/77391e388303af5513d09bcd640f116c"))

First install this script: Scripts|Manage scripts|New…, type url2script, then paste the content of the script at the url above in place of the default template, save, and finally Scripts|Manage scripts|Reload menu

Then to install a new script from (say) gist, just click on Scripts|url2script, paste in the url of the target script, type a script name (save it in the default directory if you don't know what you're doing) and reload the menu. Sometimes it can figure out a good default name.

The new version can update a script that was downloaded with url2script. This is possible because the url is stored in and read from the file (in a submodule).