Paste: Flickr API Implementation

! Copyright (C) 2011 Umur Gedik
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators formatting http.client 
json.reader kernel math sequences sorting utils urls.encoding 
hashtables make images.http multiline math.parser images.viewer
images.jpeg arrays locals io ascii ;

IN: flickr

SYMBOL: small
SYMBOL: thumbnail
SYMBOL: medium
SYMBOL: large

TUPLE: photo farm id isfamily isfriend ispublic owner secret server title ;
TUPLE: user id username realname location photos-url profile-url iconfarm
    iconserver photos-count ;
TUPLE: group id name 18-plus ;
TUPLE: comment id content iconfarm iconserver author authorname
    datecreate permalink ;

<PRIVATE

CONSTANT: API-URL "http://api.flickr.com/services/rest/?format=json&"
! change it with your api key
CONSTANT: API-KEY "XXXXXXXXXXXXXXXXXXXXXXX"

: size>string ( size -- string )
    {
        { small [ "s"] }
        { thumbnail [ "t" ] }
        { medium [ "m" ] }
        { large [ "b" ] }
        [ "Wrong size for photo!" throw ]
    } case ;

: photo>url ( size photo -- url )
    [ size>string ] dip
    {
        [ secret>> ]
        [ id>> ]
        [ server>> ]
        [ farm>> ]
    } cleave
    [
        "http://farm" % #
        ".static.flickr.com/" % %
        "/" % % "_" % % "_" % % ".jpg" %
    ] "" make ;

: json-data ( query -- assoc )
    >alist assoc>query
    API-URL prepend "&api_key=" API-KEY append append
    http-get nip dup length 1 - 14 rot swapd subseq json> ;

:: (query) ( data method variables -- result )
    method "flickr." prepend "method" variables set-at
    variables json-data data swap at ;

:: (photos.search) ( search query perpage -- photos )
    "photos" "photos.search"
    H{ search => query "per_page" => perpage } (query)
    "photo" swap at
    [
        \ photo from-slots
    ] map ;

:: (photos.comments) ( data variables method -- result )
    data method variables (query) ;

:: (people) ( data variables method -- result )
    data method variables (query) ;

PRIVATE>

#! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#! flickr.people.*

:: people.find-by-username ( username -- userid )
    "user" H{ "username" => username } "people.findByUsername" (people)
    "id" swap at ;

:: people.find-by-email ( email -- userid )
    "user" H{ "find_email" => email } "people.findByEmail" (people)
    "id" swap at ;

:: people.get-info ( userid -- user )
    "person" H{ "user_id" => userid } "people.getInfo" (people)
    {
        [ "id" swap at ]
        [ "username" swap at "_content" swap at ]
        [ "realname" swap at "_content" swap at ]
        [ "location" swap at "_content" swap at ]
        [ "photosurl" swap at "_content" swap at ]
        [ "profileurl" swap at "_content" swap at ]
        [ "iconfarm" swap at ]
        [ "iconserver" swap at ]
        [ "photos" swap at "count" swap at "_content" swap at ]
    } cleave 
    user boa ;

:: people.get-public-photos ( userid perpage -- user )
    "photos" H{ "user_id" => userid "per_page" => perpage }
    "people.getPublicPhotos" (people) "photo" swap at
    [
        \ photo from-slots
    ] map ;

:: people.get-public-groups ( userid -- groups admin-groups )
    "groups" H{ "user_id" => userid }
    "people.getPublicGroups" (people) "group" swap at dup
    [ "admin" swap at 0 = ] filter
    [
        [ "admin" swap delete-at ] keep
        { [ "nsid" swap at ] [ "name" swap at ] [ "eighteenplus" swap at ] }
        cleave group boa
    ] map
    swap
    [ "admin" swap at 1 = ] filter
    [
        [ "admin" swap delete-at ] keep
        { [ "nsid" swap at ] [ "name" swap at ] [ "eighteenplus" swap at ] }
        cleave group boa
    ] map ;

#! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#! flickr.photos.*

: photos.search.user ( username perpage -- photos )
    [ people.find-by-username ] dip "user_id" -rot (photos.search) ;

: photos.search.tags ( tags perpage -- photos )
    "tags" -rot (photos.search) ;

: photos.search.text ( query perpage -- photos )
    "text" -rot (photos.search) ;

:: photos.comments.get-list ( photoid -- comments )
    "comments" H{ "photo_id" => photoid }
    "photos.comments.getList" (photos.comments)
    "comment" swap at
    [
        [ "content" "_content" rot rename-at ] keep
        \ comment from-slots
    ] map ;

#! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#! utils

: photo>image ( photo size -- image )
    photo>url load-http-image ;

: photos>images ( photos size -- seq )
    swap
    [
        dupd photo>url load-http-image
    ] map swap drop ;

: photos. ( photos size -- )
    photos>images
    [ image. ] each ;