Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 72ac9c629f
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 146 lines (123 sloc) 5.427 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
#lang racket

(require net/url
         mzlib/os
         racket/path
         web-server/http
         web-server/dispatch
         web-server/servlet-env
         "vendor/twatlr/twatlr.rkt"
         (planet dyoo/string-template:1:0/string-template))

(define app-path (path-only (find-system-path 'run-file)))

; Dispatcher
(define-values (twatlr-dispatch twatlr-url)
  (dispatch-rules
    [("") home-page]
    [("thread") redirect-thread]
    [("thread" (string-arg)) view-thread]
    [((number-arg)) redirect-thread-2]))

; Home page responder
(define (home-page req)
  (render home-page-tmpl (hash "labelclass" "notice"
                               "labeltext" "Enter the URL of a tweet below ↓")))

; Redirect responders
(define (redirect-thread req)
  (match (assoc 'tweet (url-query (request-uri req)))
    [(cons k v) (redirect-to (string-append "/thread/" (or (extract-id v) v)) permanently)]
    [_ (not-found req)]))

(define (redirect-thread-2 req t)
  (let ([t (number->string t)])
    (redirect-to (string-append "/thread/" (or (extract-id t) t)) permanently)))

; View thread responder
(define (view-thread req t)
  (if (extract-id t)
    (if (hash-has-key? (get-tweet t) 'error)
      (not-found req)
      (render view-thread-tmpl (hash "content" (thread->string (get-thread t)))))
    (not-found req)))

; 404 responder
(define (not-found req)
  (render home-page-tmpl (hash "labelclass" "error"
                               "labeltext" "Not found — Try again :(")))

; Templates
(define-values (home-page-tmpl view-thread-tmpl head-tmpl tweet-tmpl tweet-error-tmpl thread-tmpl)
  (values (make-template (file->string (build-path app-path "views" "home-page.html")))
          (make-template (file->string (build-path app-path "views" "view-thread.html")))
          (make-template (file->string (build-path app-path "views" "_head.html")))
          (make-template (file->string (build-path app-path "views" "_tweet.html")))
          (make-template (file->string (build-path app-path "views" "_tweet-error.html")))
          (make-template (file->string (build-path app-path "views" "_thread.html")))))

; Render view
(define (render tmpl [data (hash)])
  (let ([output (template->string tmpl (hash-set data "head" (template->string head-tmpl (hash))))])
    (response/full
      200 #"Okay"
      (current-seconds) TEXT/HTML-MIME-TYPE
      (list (make-header #"X-LOL" #"NO U"))
      (list (string->bytes/utf-8 output)))))

; Render 404
(define (render-404 tmpl [data (hash)])
  (let ([output (template->string tmpl data)])
    (response/full
      404 #"Not Found"
      (current-seconds) TEXT/HTML-MIME-TYPE
      (list (make-header #"X-LOL" #"NO U"))
      (list (string->bytes/utf-8 output)))))

; Render a thread to a HTML
(define (thread->string thread)
  (template->string thread-tmpl
    (hash
      "numtweets" (number->string (length thread))
      "numusers" (length (remove-duplicates (filter string? (map get-user-name thread))))
      "tweets" (foldr string-append
                    ""
                    (map tweet->string (reverse thread))))))

; Render a tweet to HTML
(define (tweet->string tweet)
  (if (hash-ref tweet 'error #f)
    (template->string tweet-error-tmpl #hash())
    (template->string tweet-tmpl (tweet->tmpl-hash tweet))))

; Convert a tweet hash (JSON) to a hash suitable for string templates
(define (tweet->tmpl-hash t)
  (hash
    "id" (hash-ref t 'id_str)
    "username" (hash-ref (hash-ref t 'user) 'name)
    "userscreenname" (hash-ref (hash-ref t 'user) 'screen_name)
    "userpic" (hash-ref (hash-ref t 'user) 'profile_image_url)
    "text" (linkify-twitter (linkify-url (hash-ref t 'text)))
    "date" (hash-ref t 'created_at)))

; Get the user's name for a given tweet
(define (get-user-name tweet)
  (if (hash-ref tweet 'error #f)
    #\nul
    (hash-ref (hash-ref tweet 'user) 'name)))

; Grab numeric ID from either ID or tweet URL
(define (extract-id url)
  (let ([match (regexp-match #px"\\d+$" url)])
    (if match
      (car match)
      #f)))

; Linkfiy all URLs in a string
(define (linkify-url text)
  (let ([r-http #px"^[a-z]+://"]
        [r-link #px"\\b(?:[a-z]+://)?(?<!@)[0-9a-z](?:[-\\d\\w.]*\\.)+[a-z]{2,4}(?:\\:\\d{1,6})?(?:[-\\d\\w./?=&#%+]*)\\b"])
          (regexp-replace* r-link text (λ (url)
                                        (let ([fixed-url (if (regexp-match? r-http url) url (string-append "http://" url))])
                                          (string-append "<a href=" fixed-url ">" url "</a>"))))))

; Linkify all Twitter usernames in a string
(define (linkify-twitter text)
  (regexp-replace* #px"@(\\w+)" text (λ (disp user)
                                       (string-append "<a href=http://twitter.com/" user ">" disp "</a>"))))

; URL to Request
(define (url->request u)
  (make-request #"GET" (string->url u) empty
                (delay empty) #f "1.2.3.4" 80 "4.3.2.1"))

; (write (twatlr-dispatch
; (url->request "http://gf3.ca/thread/1234abcd")))

(with-output-to-file (build-path app-path "app.pid") (λ () (write (getpid))))
(serve/servlet twatlr-dispatch
  #:extra-files-paths (list (build-path app-path "public"))
  #:log-file (build-path app-path "log" "app.log")
  #:servlet-regexp #rx""
  #:servlet-path "/"
  #:launch-browser? #f
  #:file-not-found-responder not-found)

Something went wrong with that request. Please try again.