haskell で twitter の timeline を取得してみる

Haskell の勉強もかねて、 Haskelltwitter の public timeline を取得してみる。

試行錯誤

HackageDB: json-0.4.3

HackageDB: hs-twitter-0.2.8

cabal install json でインストール可能。
hs-twitter の依存に入っているから cabal install hs-twitter だけでもいいかもしれない。

hs-twitter

hs-twitter 使いにくい。
コード読んでみたところ、ユーザ認証は setTwitterUser しかないっぽい。
ユーザ名とパスワードの入力が標準入力からになっているのでどう使ったものやら。

なのでここは直接 HTTP で GET して JSON をパースする方向に。

用意するもの

メモ

rational -> integer は Data.Ratio.numerator

JSON の使い方参考
Haskell で json を扱う - EAGLE 雑記

HackageDB: HTTP-4000.0.9

とりあえず

(simpleHTTP $ getRequest url) >>= getResponseBody

だけで url からのデータ取得はできるので、このデータを json であれこれ弄ればできあがり。

tweet 取得はこんな感じ。
うまい人が書いたらもっと短かったりするんだろうなあ。

具体的には取得したデータを deserialize してリストにした後、data で定義した構造に変換してやるだけ。

getPublicTimeline = (simpleHTTP $ getRequest url) >>= getResponseBody >>= (return . mkTweet . tolist)
    where
        url = "http://twitter.com/statuses/public_timeline.json"
        tolist str = let Ok x = decode str
                     in x
        mkTweet = map toTweet

次は tweet かな。

ソースコード

import Network.HTTP
import Text.JSON
import Data.Ratio

import Debug.Trace


data Geo = Geo
    {
        locationType :: String,
        coordinates :: [Double]
    } deriving Show


data User = User
    {
        contributorsEnabled :: Bool,
        userCreatedAt :: String,
        description :: String,
        favoritesCount :: Integer,
        followersCount :: Integer,
        following :: Bool,
        friendsCount :: Integer,
        geoEnabled :: Bool,
        userId :: Integer,
        lang :: String,
        location :: String,
        name :: String,
        notifications :: Bool,
        profileBackgroundColor :: String,
        profileBackgroundImageUrl :: String,
        profileBackgroundTile :: Bool,
        profileImageUrl :: String,
        profileLinkColor :: String,
        profileSidebarFillColor :: String,
        profileSidebarBorderColor :: String,
        profileTextColor :: String,
        protected :: Bool,
        screenName :: String,
        statusesCount :: Integer,
        timeZone :: Maybe String,
        url :: Maybe String,
        utcOffset :: Maybe Integer,
        verified :: Bool
    } deriving Show


data Tweet = Tweet
    {
        contributors :: Maybe String,
        tweetCreatedAt :: String,
        favorited :: Bool,
        geo :: Maybe Geo,
        tweetId :: Integer,
        inReplyToScreenName :: Maybe String,
        inReplyToStatusId :: Maybe Integer,
        inReplyToUserId :: Maybe Integer,
        source :: String,
        text :: String,
        truncated :: Bool,
        userObj :: User
    } deriving Show


toGeo obj = Geo
            {
                locationType = getString obj "type",
                coordinates = getArray (\ (JSRational _ x) -> fromRational x) obj "coordinates"
            }


toUser obj = User
             {
                 contributorsEnabled = getBool obj "contributors_enabled",
                 userCreatedAt = getString obj "created_at",
                 description = getNullDefault getString obj "description" "",
                 favoritesCount = getInteger obj "favourites_count",
                 followersCount = getInteger obj "followers_count",
                 following = getNullDefault getBool obj "following" False,
                 friendsCount = getInteger obj "friends_count",
                 geoEnabled = getBool obj "geo_enabled",
                 userId = getInteger obj "id",
                 lang = getString obj "lang",
                 location = getNullDefault getString obj "location" "",
                 name = getString obj "name",
                 notifications = getNullDefault getBool obj "notifications" False,
                 profileBackgroundColor = getString obj "profile_background_color",
                 profileBackgroundImageUrl = getString obj "profile_background_image_url",
                 profileBackgroundTile = getBool obj "profile_background_tile",
                 profileImageUrl = getString obj "profile_image_url",
                 profileLinkColor = getString obj "profile_link_color",
                 profileSidebarFillColor = getString obj "profile_sidebar_fill_color",
                 profileSidebarBorderColor = getString obj "profile_sidebar_border_color",
                 profileTextColor = getString obj "profile_text_color",
                 protected = getBool obj "protected",
                 screenName = getString obj "screen_name",
                 statusesCount = getInteger obj "statuses_count",
                 timeZone = getNullable getString obj "time_zone",
                 url = getNullable getString obj "url",
                 utcOffset = getNullable getInteger obj "utc_offset",
                 verified = getBool obj "verified"
             }


toTweet obj = Tweet
              {
                  contributors = getNullable getString obj "contributors",
                  tweetCreatedAt = getString obj "created_at",
                  favorited = getBool obj "favorited",
                  geo = getNullable ((toGeo .) . getObject) obj "geo",
                  tweetId = getInteger obj "id",
                  inReplyToScreenName = getNullable getString obj "in_reply_to_screen_name",
                  inReplyToStatusId = getNullable getInteger obj "in_reply_to_status_id",
                  inReplyToUserId = getNullable getInteger obj "in_reply_to_user_id",
                  source = getString obj "source",
                  text = getString obj "text",
                  truncated = getBool obj "truncated",
                  userObj = toUser $ getObject obj "user" 
              }


getOk (Ok x) = x


debugOutput x = traceShow x x

toString (JSString txt) = fromJSString txt

getObject obj name = let Ok (JSObject x) = valFromObj name obj in x

getRational obj name = let Ok (JSRational _ x) = valFromObj name obj in x

getArray func obj name = let Ok (JSArray x) = valFromObj name obj in map func x

getInteger = (numerator .). getRational

getFloat = (fromRational .). getRational

getBool obj name = let Ok (JSBool x) = valFromObj name obj in x

getNullable func obj name = makeRet val
    where
        Ok val = valFromObj name obj
        makeRet JSNull = Nothing
        makeRet x = Just $ func obj name


getNullDefault func obj name def = makeRet val
    where
        Ok val = valFromObj name obj
        makeRet JSNull = def
        makeRet x = func obj name


getPublicTimeline = (simpleHTTP $ getRequest url) >>= getResponseBody >>= (return . mkTweet . tolist)
    where
        url = "http://twitter.com/statuses/public_timeline.json"
        tolist str = let Ok x = decode str
                     in x
        mkTweet = map toTweet

getString obj name = fromJSString txt
    where
        Ok (JSString txt) = traceShow name $ debugOutput $ valFromObj name obj

getText obj = getString obj "text"


main :: IO ()
main = do
    tl <- getPublicTimeline
    mapM_ (\ Tweet {text = x} -> print x) tl