Twitter Land

shuji.scm

(define shuji     (make-profile 'shuji) )
(define yamasushi (make-profile 'yamasushi) )
(define syamamoto (make-profile 'syamamoto) )


(define shuji-data-0 
  ( $ post "3rd(reply/RT it)"
    $ post "2nd"
    $ post "1st" shuji ) )

(define yamasushi-data-0
  ( $ post "this is shuji's"
    $ retweet (profile-get-last-tweet shuji-data-0)
    $ post "hello!" yamasushi ) )

(define syamamoto-data-0
  (let1 tw (profile-get-last-tweet shuji-data-0) 
    ( $ reply tw (make-quote "WTF!! :(" "3rd" (tweet-get-person tw) ) 
      $ reply-last "that is a table."
      $ reply-last "this is a pen."
      $ post ":-)" syamamoto ) ) )

(define shuji-data-1
  ( $ reply (profile-get-last-tweet syamamoto-data-0) "hehe"
    $ reply (profile-get-last-tweet yamasushi-data-0) "THX!" shuji-data-0) )

(define syamamoto-data-1
  ( $ reply-last "Whooooaa!!!"
    $ reply-last "Booo"
    $ retweet (profile-get-tweet shuji-data-1 1) syamamoto-data-0 ) )

talk.scm

; talk

(define shuji     (make-profile 'shuji) )
(define yamasushi (make-profile 'yamasushi) )
(define syamamoto (make-profile 'syamamoto) )

(define talk-0
  ( $ pair-quote "What?" "Hmmmm" $ pair-swap
    $ pair-monologue "Hmmmm...... :-< "
    $ pair-talk "hi" $ pair-swap
    $ pair-talk "hello" (make-pair shuji yamasushi) ) )

twitter-land.scm

; - - - - - - - - - - - - - - - - - - 
; context : [content]
; reply : [content]
; reply-tail  : [content] , reply : content . reply-tail 
; tweet : (context . reply-tail )
; (caar tweet) = (car context) = content of tweet
; content : (text . person)
; quote-text : (text quote-text . quoted-person) )
; quote-content : ((text quote-text . quoted-person) . person)

(define (make-content text p) 
  (cons* text p) )

(define (content-get-person content)
  (cdr content) )

(define (tweet-get-content     tweet) 
  ;#?= tweet
  (if (or (null? tweet) (null? (car tweet) ) )
    '()
    (caar tweet) ) )

(define (tweet-get-context     tweet) 
  ;#?= tweet
  (if (null? tweet)
    '()
    (car tweet) ) )

(define (tweet-get-context-tail     tweet) 
  ;#?= tweet
  (if (or (null? tweet) (null? (car tweet)) )
    '()
    (cdar tweet) ) )

(define (tweet-get-person tweet)
  ($ content-get-person $ car $ tweet-get-context tweet ) )

(define (make-quote text qtext qp) 
  (cons* text qtext qp) )

; - - - - - - - - - - - - - - - - - - 

(define (tweet-get-reply-tail tweet) 
  (if (null? tweet)
    '()
    (cdr tweet) ) )

(define (tweet-get-reply tweet) 
  (if (or (null? tweet) (null? (car tweet) ) )
    '()
    (cons (caar tweet) (tweet-get-reply-tail tweet) ) ) )

(define null-tweet '( () . () ) )

(define (tweet-reply me to content)
  (cons 
    (cons content (tweet-get-context me) )
    (tweet-get-reply to) ) )

(define (tweet-post me content)
  (cons (cons content (tweet-get-context me) ) '() ) )

(define (tweet-self-reply me content)
  (tweet-reply me me content ) )

(define (tweet-retweet me to)
  (cons
    (cons (tweet-get-content to) (tweet-get-context me) )
    (tweet-get-reply-tail to ) ) )
  

(define (tweet-println tweet)
  (format #t "content:~s~%  context-tail:~s~%  reply-tail:~s~%"
    (tweet-get-content tweet)
    (tweet-get-context-tail tweet)
    (tweet-get-reply-tail tweet) ) )

; - - - - - - - - - - - - - - - - - - 
; timeline : [ tweet ]
(define (timeline-println tl)
  (for-each tweet-println tl) )

; - - - - - - - - - - - - - - - - - - 
; profile : (timeline . person)
(define (profile-get-person prof)
  (cdr prof) )

(define (profile-get-timeline prof)
  (car prof) )

(define (profile-get-tweet prof i) (~ (profile-get-timeline prof) i) )
(define (profile-get-last-tweet prof) ($ car $ profile-get-timeline prof) )

(define (profile-println prof)
  (format #t "person:~s~%timeline:~%" (profile-get-person prof) )
  ($ timeline-println $ profile-get-timeline prof) )

(define (make-profile p)
  (cons* `(,null-tweet) p) )

; - - - - - - - - - - - - - - - - - - 
; pair (speaker . listner)
(define (make-pair p q) (cons p q) )
(define (pair-get-speaker  p) (car p) )
(define (pair-get-listener p) (cdr p) )
(define (pair-swap p) (make-pair (pair-get-listener p) (pair-get-speaker p) ) )

; - - - - - - - - - - - - - - - - - - 
(define (reply to text prof)
  (let [(tl (car prof) ) (p (cdr prof) )]
    (cons* 
      (cons (tweet-reply (car tl) to (make-content text p) ) tl ) p ) ) )

(define (post text prof)
  (let [(tl (car prof) ) (p (cdr prof) )]
    (cons*
      (cons (tweet-post (car tl) (make-content text p)) tl) p ) ) )

(define (self-reply text prof)
  (let [(tl (car prof) ) (p (cdr prof) )]
    (cons*
      (cons (tweet-self-reply (car tl) (make-content text p) ) tl ) p ) ) )

(define (retweet to prof)
  (let [(tl (car prof) ) (p (cdr prof) )]
    (cons*
      (cons (tweet-retweet (car tl) to) tl) p ) ) )

(define (reply-last text prof)
  (reply (profile-get-last-tweet prof) text prof) )

; - - - - - - - - - - - - - - - - - - 
(define (pair-talk text p)
  (let [(speaker (pair-get-speaker p) ) (listener (pair-get-listener p) ) ]
    (make-pair
      (reply (profile-get-last-tweet listener) text speaker)
      listener ) ) )

(define (pair-monologue text p)
  (let [(speaker (pair-get-speaker p) ) (listener (pair-get-listener p) ) ]
    (make-pair (self-reply text speaker) listener ) ) )

(define (pair-quote text quote-text p)
  (let* [
    (speaker (pair-get-speaker p)   ) 
    (listener (pair-get-listener p) ) 
    (quoted-tweet (profile-get-last-tweet listener) ) ]
      (make-pair
        (reply quoted-tweet (make-quote text quote-text (tweet-get-person quoted-tweet) ) speaker)
        listener ) ) )