Twitterで指定したスクリーン名のユーザーのタイムラインを取得する処理

IDs.hs

{-# LANGUAGE OverloadedStrings #-}

module Twitter.Types.IDs (
  IDs
  , get_ids) where

import Twitter.Types.Json
import Data.Aeson
import Control.Monad (mzero)
import Control.Applicative ((<$>), (<*>))

data IDs = IDs {
    get_ids :: [Integer]
  , get_next_cursor :: Int
  , get_next_cursor_str :: String
  , get_previous_cursor :: Int
  , get_previous_cursor_str :: String
  } deriving (Show)

instance Json IDs

instance FromJSON IDs where
  parseJSON (Object obj) = IDs <$>
                           (obj .: "ids")                 <*>
                           (obj .: "next_cursor")         <*>
                           (obj .: "next_cursor_str")     <*>
                           (obj .: "previous_cursor")     <*>
                           (obj .: "previous_cursor_str")
  parseJSON _ = mzero

instance ToJSON IDs where
  toJSON o = object ["ids"              .= get_ids o
                    , "next_cursor"     .= get_next_cursor o
                    , "next_cursor_str" .= get_next_cursor_str o
                    , "previous_cursor" .= get_previous_cursor o
                    , "previous_cursor_str" .=
                      get_previous_cursor_str o]

Json.hs

module Twitter.Types.Json where

import Data.Aeson
import qualified Data.Aeson.Types as T
import Data.Attoparsec
import qualified Data.ByteString.Char8 as BS

class (FromJSON a) => Json a where
  parseJson :: BS.ByteString -> Maybe a
  parseJson bs = concretize parsed
    where
      parsed = parse json bs
      concretize (Done _ r) = T.parseMaybe parseJSON r
      concretize _          = Nothing

main.hs

import System.Environment(getArgs)
import System.Exit(exitSuccess, exitFailure)
import System.IO
import Twitter
import Control.Applicative ((<$>))
import Control.Monad
import qualified Data.ByteString as BS

saveUserTimelineFromScreenName cred screenName = do
  timeline <- getUserTimelineFromScreenName cred screenName
  BS.writeFile (screenName ++ "_timeline.json") timeline
  let tweets = pickupTweetsFromUserTimeline timeline
  withFile (screenName ++ "_timeline.txt") WriteMode
    (\h -> do mapM_ (hPutStrLn h) tweets)
  return tweets

saveUserTimelineFromID cred id = do
  let idString = show id
  timeline <- getUserTimelineFromID cred id
  BS.writeFile (idString ++ "_timeline.json") timeline
  let tweets = pickupTweetsFromUserTimeline timeline
  withFile (idString ++ "_timeline.txt") WriteMode
    (\h -> do mapM_ (hPutStrLn h) tweets)
  return tweets

saveFollowerIDsFromScreenName cred screenName = do
  idString <- getFollowerIDsFromScreenName cred screenName
  BS.writeFile (screenName ++ "_ids.json") idString
  let ids = pickupIDsFromFollowerIDs idString
  withFile (screenName ++ "_ids.txt") WriteMode
    (\h -> mapM_ ((hPutStrLn h) . show) ids)
  return ids

saveAriyoshiFollowerIDs cred = do
  ids <- saveFollowerIDsFromScreenName cred "ariyoshihiroiki"
  mapM_ (saveUserTimelineFromID cred) ids
  return ()

loadIDs path = do
  ss <- lines <$> readFile path
  return $ map read ss

saveIDs path ids = do
  withFile path WriteMode $ \h -> do
    mapM_ ((hPutStrLn h).read ) ids

main = do
  (credentialFile:id:_) <- getArgs
  cred <- newCredentialInfo credentialFile
  let i = (read id) :: Integer
  saveUserTimelineFromID cred i
  return ()

main0 = do
  (credentialFile:args) <- getArgs
  cred <- newCredentialInfo credentialFile
  if length args == 0
    then do
    saveAriyoshiFollowerIDs cred
    return ()
    else do
    let idFile = head args
    ids <- loadIDs idFile
    case splitAt 180 ids of
      ([], _) -> return ()
      (targetIDs, rest) -> do
        mapM_ (saveUserTimelineFromID cred) targetIDs
        saveIDs idFile rest
  return ()

OAuth.hs

{-# LANGUAGE OverloadedStrings #-}

module Twitter.OAuth (newCredentialInfo, CredentialInfo) where

import Control.Monad (mzero)
import Control.Applicative ((<*>), (<*), (*>), (<$>), (<|>))
import Data.Aeson
import qualified Data.Aeson.Types as T
import Data.Attoparsec
import Data.Text (Text)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LC (unpack)
import qualified Web.Authenticate.OAuth as AO

type CredentialInfo = ( AO.OAuth
                      , AO.Credential)

data AccessInfo = AccessInfo {
    getOAuthConsumerKey    :: BS.ByteString
  , getOAuthConsumerSecret :: BS.ByteString
  , getAccessToken         :: BS.ByteString
  , getAccessTokenSecret   :: BS.ByteString
  } deriving (Show, Eq)

instance FromJSON AccessInfo where
  parseJSON (Object obj) = AccessInfo <$>
                           (obj .: "OAuthConsumerKey")    <*>
                           (obj .: "OAuthConsumerSecret") <*>
                           (obj .: "AccessToken")         <*>
                           (obj .: "AccessTokenSecret")   
  parseJSON _ = mzero

instance ToJSON AccessInfo where
  toJSON i = object
             [ "OAuthConsumerKey"    .= getOAuthConsumerKey    i
             , "OAuthConsumerSecret" .= getOAuthConsumerSecret i
             , "AccessToken"         .= getAccessToken         i
             , "AccessTokenSecret"   .= getAccessTokenSecret   i]

parseAccessInfo :: String -> Maybe AccessInfo
parseAccessInfo s = case parse json (BS.pack s) of
  (Done _ r) -> T.parseMaybe parseJSON r :: Maybe AccessInfo
  _          -> Nothing

twitterRequestUri  = "https://api.twitter.com/oauth/request_token"
twitterAccessTokenUri ="https://api.twitter.com/oauth/access_token"
twitterAuthorizeUri = "https://api.twitter.com/oauth/authorize"

makeCredentialInfo :: AccessInfo -> CredentialInfo
makeCredentialInfo info = (oauth, credential)
  where
    oauth = AO.newOAuth {
        AO.oauthRequestUri     = twitterRequestUri
      , AO.oauthAccessTokenUri = twitterAccessTokenUri
      , AO.oauthAuthorizeUri   = twitterAuthorizeUri
      , AO.oauthConsumerKey    = getOAuthConsumerKey info
      , AO.oauthConsumerSecret = getOAuthConsumerSecret info
      }
    credential = AO.newCredential
                 (getAccessToken info)
                 (getAccessTokenSecret info)
    
newCredentialInfo :: FilePath -> IO CredentialInfo
newCredentialInfo filePath = do
  s <- readFile filePath 
  case parseAccessInfo s of
    (Just c) -> return $ makeCredentialInfo c

Tweet.hs

{-# LANGUAGE OverloadedStrings #-}

module Twitter.Types.Tweet
       (Tweet
       ,get_text) where

import Twitter.Types.Json
import Twitter.Types.User
import Twitter.Types.Entities
import Twitter.Types.TweetEntities
import Data.Aeson
import qualified Data.Aeson.Types as T
import Data.Attoparsec
import Control.Monad (mzero)
import Control.Applicative ((<$>), (<*>))
import Data.Time.Format     (parseTime)
import Data.Time.Clock      (UTCTime)
import System.Locale        (defaultTimeLocale)
import qualified Data.ByteString.Char8 as BS


data Tweet = Tweet {
    get_created_at :: String
  , get_id :: Integer
--  , get_id_str :: String
  , get_text :: String
--  , get_source :: String
  -- , get_truncated :: Bool
  -- , get_in_reply_to_status_id :: Maybe Integer
  -- , get_in_reply_to_status_id_str :: Maybe String
  -- , get_in_reply_to_user_id :: Maybe Integer
  -- , get_in_reply_to_user_id_str :: Maybe String
  -- , get_in_reply_to_screen_name :: Maybe String
  -- , get_user :: User
  -- , get_geo :: Maybe String
  -- , get_coordinates :: Maybe String
  -- , get_place :: Maybe String
  -- , get_contributors :: Maybe String
  -- , get_retweet_count :: Int
  -- , get_entities :: TweetEntities
  -- , get_favorited :: Bool
  -- , get_retweeted :: Bool 
} deriving (Show)


instance FromJSON Tweet where
  parseJSON (Object obj) = Tweet <$>
                           (obj .: "created_at")                <*>
                           (obj .: "id")                        <*>
--                           (obj .: "id_str")                    <*>
                           (obj .: "text")                      -- <*>
                           -- (obj .: "source")                    <*>
                           -- (obj .: "truncated")                 <*>
                           -- (obj .: "in_reply_to_status_id")     <*>
                           -- (obj .: "in_reply_to_status_id_str") <*>
                           -- (obj .: "in_reply_to_user_id")       <*>
                           -- (obj .: "in_reply_to_user_id_str")   <*>
                           -- (obj .: "in_reply_to_screen_name")   <*>
                           -- (obj .: "user")                      <*>
                           -- (obj .: "geo")                       <*>
                           -- (obj .: "coordinates")               <*>
                           -- (obj .: "place")                     <*>
                           -- (obj .: "contributors")              <*>
                           -- (obj .: "retweet_count")             <*>
                           -- (obj .: "entities")                  <*>
                           -- (obj .: "favorited")                 <*>
                           -- (obj .: "retweeted")
  parseJSON _ = mzero

instance ToJSON Tweet where
  toJSON o = object ["created_at" .= get_created_at o
                    ,"id" .= get_id o
--                    ,"id_str" .= get_id_str o
                    ,"text" .= get_text o
                   --  ,"source" .= get_source o
                   --  ,"truncated" .= get_truncated o
                   --  ,"in_reply_to_status_id" .= get_in_reply_to_status_id o
                   --  ,"in_reply_to_status_id_str" .= get_in_reply_to_status_id_str o
                   --  ,"in_reply_to_user_id" .= get_in_reply_to_user_id o
                   --  ,"in_reply_to_user_id_str" .= get_in_reply_to_user_id_str o
                   --  ,"in_reply_to_screen_name" .= get_in_reply_to_screen_name o
                   -- ,"user" .= get_user o
                   --  ,"geo" .= get_geo o
                   --  ,"coordinates" .= get_coordinates o
                   --  ,"place" .= get_place o
                   --  ,"contributors" .= get_contributors o
                   --  ,"retweet_count" .= get_retweet_count o
                   --  ,"entities" .= get_entities o
                   --  ,"favorited" .= get_favorited o
                   --  ,"retweeted" .= get_retweeted o
                    ]

instance Json Tweet

Twitter.hs

import System.IO
import Control.Monad.IO.Class (liftIO)
import Control.Applicative ((<$>))

import Twitter.Types
import Twitter.OAuth

mentions_timeline = "https://api.twitter.com/1.1/statuses/mentions_timeline.json"
user_timeline     = "https://api.twitter.com/1.1/statuses/user_timeline.json"
home_timeline     = "https://api.twitter.com/1.1/statuses/home_timeline.json"

follower_ids = "https://api.twitter.com/1.1/followers/ids.json"
followers =    "https://api.twitter.com/1.1/followers/list.json"

sendGetRequest (oauth, credential) url = do
  ss <- runResourceT $ do
    manager       <- liftIO $ newManager def
    request       <- liftIO $ parseUrl $ url
    signedRequest <- signOAuth oauth credential request
    response      <- http signedRequest manager
    -- responseBody response $$+- CB.sinkHandle stdout
    responseBody response $$+- (CL.consume)
  return $ BS.concat ss

getUserTimelineFromScreenName cred screenName =
  sendGetRequest cred url
  where
    url = user_timeline ++ "?count=200&screen_name=" ++ screenName

getUserTimelineFromID cred id =
  sendGetRequest cred url
  where
    url = user_timeline ++ "?count=200&user_id=" ++ (show id)

getFollowerIDsFromScreenName cred screenName = sendGetRequest cred url
  where
    url = follower_ids ++ "?screen_name=" ++ screenName

pickupIDsFromFollowerIDs s = get_ids x
  where
    (Just x) = (parseJson s) :: Maybe IDs

pickupTweetsFromUserTimeline s = map get_text tweets
  where
    (Just x) = (parseJson s) :: Maybe UserTimeline
    tweets = getTweets x

Types.hs

module Twitter.Types (
  UserTimeline
  , IDs
  , Tweet
  , getTweets
  , get_text
  , parseJson
  , get_ids
  ) where

import Twitter.Types.Json
import Twitter.Types.IDs
import Twitter.Types.UserTimeline
import Twitter.Types.Tweet

UserTimeline.hs

{-# LANGUAGE OverloadedStrings #-}

module Twitter.Types.UserTimeline
       ( UserTimeline
       , getTweets
       ) where

import Twitter.Types.Json
import Twitter.Types.Tweet
import Data.Aeson
import qualified Data.Aeson.Types as T
import Data.Attoparsec
import Control.Monad (mzero)
import Control.Applicative ((<$>), (<*>))
import Data.Time.Format     (parseTime)
import Data.Time.Clock      (UTCTime)
import System.Locale        (defaultTimeLocale)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V

data UserTimeline = UserTimeline {
  getTweets :: [Tweet]
  }  deriving (Show)

instance FromJSON UserTimeline where
  parseJSON (Array obj) = UserTimeline <$>
                          mapM parseJSON (V.toList obj)

instance Json UserTimeline

parseTwitterTime :: String -> Maybe UTCTime
parseTwitterTime = parseTime defaultTimeLocale "%a %b %d %X %z %Y"