;; Facebook Hooks for UCB Scheme
;; http://developers.facebook.com/docs/reference/api/
;; v0.9

;;; Connecting to Facebook's Open Graph API

;; Queries Facebook's Open Graph API for data and returns the response in a
;; deep association list.
(define (make-request request options-alist)
  (listify-response
   (exec (string-append "curl -s \"https://graph.facebook.com/"
                        request
                        (make-options-string options-alist)
						"\""))))

;; Sends a "post" request to Facebook's Open Graph API.
;; Arguments may be provided through an association list.
;; Check the Facebook Open Graph API for the return value of a
;; particular post request.
(define (make-post-request request arguments-alist)
  (listify-response
   (exec (fprintf "curl ~A -s \"https://graph.facebook.com/~A\""
                  (make-post-arguments-string arguments-alist)
                  request))))


;;; String helper functions:

;; Create a string from an association list of options.
;; For multiple options, place your values in a list.
;; eg. (make-options-string (list (cons "fields" (list "name" "id" "gender"))
;;								  (cons "access_token" "")))
;;				=> "?fields=name,id,gender&
;; The resulting string can be appended to the end of a request.
(define (make-options-string options-alist)
  (define (commaify lst)
    (cond ((atom? lst) lst)
		  ((null? (cdr lst)) (car lst))
		  (else (string-append (car lst) "," (commaify (cdr lst))))))
  (define (make-options-string-helper str alist)
    (cond ((null? alist) str)
          ((empty? str)
           (make-options-string-helper
            (fprintf "?~A=~A" (caar alist) (commaify (cdar alist)))
            (cdr alist)))
          (else (make-options-string-helper
                 (fprintf "~A&~A=~A" str (caar alist) (commaify (cdar alist)))
                 (cdr alist)))))
  (make-options-string-helper "" options-alist))


;; Usage: (fprintf <format-string> <arg1> <arg2> <arg3> ...)
;; You should not need to use this procedure.
(define (fprintf str . data)
  (let ((p (open-output-string)))
    (apply format (append (list p str) data))
    (get-output-string p)))

;; Create a string from an association list of arguments
;; You should not need to use this procedure.
(define (make-post-arguments-string arguments-alist)
  (apply string-append (map (lambda (argument-pair) (fprintf "-F '~A=~A' "
                                                             (car argument-pair)
                                                             (cdr argument-pair)))
                            arguments-alist)))



;;; Response parsing helper functions.

;; You should not need to use the following two procedures.
(define (my-replace pattern substitute string)
  (regexp-replace-all pattern string substitute))
(define (listify-response str-response)
  (eval-string (fprintf "~A~A~A" "(quote ("
                        (my-replace
                         "}"
                         ") )"
                         (my-replace
                          "{"
                          "( ("
                          (my-replace
                           "},"
                           " ))) ( "
                           (my-replace
                            ":{"
                            " . ( ("
                            (my-replace
                             "\",\""
                             "\") ( \""
                             (my-replace
                              "\":\""
                              "\" . \""
                              (my-replace
                               "\\["
                               "{"
                               (my-replace
                                "\\]"
                                "}"
                                str-response))))))))
                        "))")))


;;; Authorization

;; Takes a string Application ID as an argument and stores it in Scheme.
(define (put-application-id app-id)
  (put 'facebook-auth 'app-id app-id))

;; Retrieves the Application ID as a string, or #f if one has not been stored.
(define (get-application-id)
  (get 'facebook-auth 'app-id))


;; Open a Facebook authorization page in the default web browser.
;; The page will ask the user to log in and allow your application access to
;; their data, as dictated by the permissions argument.
;;
;; Example call: (launch-auth-page "user_birthday" "publish_stream" "user_location" "friends_likes")
;; Reference: http://developers.facebook.com/docs/authentication/permissions
(define (launch-auth-page . permissions)
  (if (get-application-id)
      (exec (fprintf "python -c \"import webbrowser; webbrowser.open('https://graph.facebook.com/oauth/authorize~A')\""
                     (make-options-string
                      (let ((standard-options
                             (list
                              (cons "client_id" (get-application-id))
                              (cons "redirect_uri"
                                    "http://www.facebook.com/connect/login_success.html")
                              (cons "display" "popup")
                              (cons "type" "user_agent"))))
                        (if (null? permissions)
                            standard-options
                            (cons (cons "scope" permissions)
                                  standard-options))
                        ))))
      (error "No application id yet! Use put-application-id.")))

;; Stores an access token as a string.
;; The url of the webpage with "Success" should be an argument to this procedure.
(define (put-access-token url)
  (let ((access-token (member "access_token" (split-string url "\#=&"))))
    (if (pair? access-token)
        (put 'facebook-auth
             'access-token
             (second (member "access_token" (split-string url "\#=&"))))
        (error "No access_token found in url!"))))

;; Retrieves the stored access token as a string, or #f if no access token
;; has been stored.
(define (get-access-token)
  (get 'facebook-auth 'access-token))

;;; Graph API interaction helper procedures

;; Takes a list of strings and forms part of a URL structure from them.
;; The result of this procedure may be passed as a "request" argument to
;; make-request and make-post-request.
;; See also: 
;;
;; Example: (create-url-structure "2204501798" "feed")
;;              => "2204501798/feed"
(define (create-url-structure lst)
  (cond ((null? lst) "")
		((atom? lst) lst)
		((null? (cdr lst)) (car lst))
		(else (string-append (car lst) "/" (create-url-structure (cdr lst))))))

(define (lookup user-id)
  (make-request (create-url-structure user-id) nil))

(define (make-authorised-request request options-alist)
  (make-request request (cons (cons "access_token" (get-access-token)) options-alist)))

(define (make-authorised-post-request request arguments-alist)
  (make-post-request request (cons (cons "access_token" (get-access-token)) arguments-alist)))

(define (get-friends user-id)
  (make-authorised-request
   (create-url-structure (list user-id "friends"))
   nil))

(define (wall-post-self message)
  (make-authorised-post-request (create-url-structure (list "me" "feed"))
								(list (cons "message" message))))

(define (get-link link)
  (exec (fprintf "python -c \"import webbrowser; webbrowser.open('~A')\"" link)))

(define (save-link link)
  (exec (fprintf "wget --quiet ~A" link)))