ログイン
編集不可のページディスカッション情報添付ファイル
kurubushi/tweeter_on_haskell

MMA

はすけるでついったーをあそぶぞ

本論

お忙しい方は,ここだけお読みください.
結論から先に書きます.

なんか,MMA wikiでMarkdownを投稿できるようになったっぽいので,
それを試してあそびたい!!

rm -rf /
#include <stdio.h>
int main(){
  printf("めでたい!\n");
}
import System.IO
import Control.Monad

main :: IO ()
main = forever $ getLine >> putStrLn "わかる"

いえぇーーい!!

蛇足

ここからは蛇足です.
忙しい方は読み飛ばしてくださっても結構です.
HaskellをつかってTwitterをあそんでみます.

使うライブラリさんたち

次のライブラリを使います.

  • authenticate-oauth
    これはTwitterで使われている認証方式OAuthにまつわるもろもろをやってくれるライブラリです.

  • conduit / extra-conduit / http-conduit
    これはストリームをいろいろやってくれるやつです.

  • aeson / attoparsec-conduit
    これはストリーム(JSON)を任意の型にパースしてくれるつよいやつです.

  • transformers
    すきです.つきあってください.

さきに,インポートするモジュールと,プラグマを書いておきましょう.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Web.Authenticate.OAuth (
  OAuth(..), Credential(..), newOAuth, newCredential, signOAuth)
import Data.Text (Text)
import Network.HTTP.Conduit (
  Request(..), urlEncodedBody, parseUrl, newManager, conduitManagerSettings, http, responseBody)
import Control.Exception (IOException,handle,displayException,SomeException)
import Control.Monad ((<=<),forever,liftM,guard,foldM,mapM,mapM_)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (runMaybeT,MaybeT(..))
import Data.Maybe (fromMaybe)
import qualified Data.Conduit.Binary as CB
import Data.Conduit (($$+-), Sink, ($$++), ($$+), newResumableSource, ResumableSource, await, Source, yield)
import qualified Data.Conduit.List as CL
import System.IO (putStrLn,hFlush,stdout,appendFile)
import Control.Monad.Trans.Resource (runResourceT, ResourceT, MonadResource)
import Data.Aeson (
  json, FromJSON, ToJSON, fromJSON, Result(..),
  parseJSON, withObject, (.:), (.:?))
import GHC.Generics
import Data.Monoid ((<>))
import System.Random (randomRIO)
import qualified Data.Conduit.Attoparsec as CA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as T
import qualified Codec.Binary.UTF8.String as UTF8

認めてもらおう

まずは,OAuthの使い方をやります.
https://apps.twitter.comにいって,アプリを申請します.
名前とかはノリでいいです.「くるぶしと酒を飲みにいきたい」,「おごってあげるので,くるぶし酒会にきてくれ」とかでいいと思います.
申請するにあたって,電話番号を登録しなきゃだったかもしれません.
そのあたりは,twitter Ruby OAuthとかで調べるとイケイケの記事がでてくると思います.

さて,みとめてもらうと,次を得られます.

  • ConsumerKey
    アプリの識別子です.

  • ConsumerSecret
    アプリの鍵です.

  • AccessToken
    アプリ利用者識別子です.

  • AccessTokenSecret
    アプリ利用者の鍵です.

次のようにして,OAuth用のデータを作ります.
なお,OverloadedStringsisString型クラスの型に"hoge"という書き方を許すもので,Data.String.fromString "hoge"と書くこととなんら変わりません.
型は推論してくれます.Haskellってすばらしいね.

oauth :: OAuth
oauth = newOAuth {
  oauthRequestUri = "https://api.twitter.com/oauth/request_token",
  oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token",
  oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize",
  oauthConsumerKey = "xxx",
  oauthConsumerSecret = "xxx"}

credential :: Credential
credential = newCredential "xxx" "xxx"

実際のTwitterAPIの利用では,signOAuth :: MonadIO m => OAuth -> Credential -> Request -> m Requestを用いて,たとえば次のようにしてAPIを使います.

tweetGen :: (MonadIO m, MonadThrow m, MonadResource m) => Request -> Sink BS.ByteString m o -> m o
tweetGen req sink = do
  manager <- liftIO $ newManager conduitManagerSettings
  signedRequest <- signOAuth oauth credential req
  res <- http signedRequest manager
  responseBody res $$+- sink

ここでは,マネージャとしてConduitを選択しました.
Conduitは,Lazy IO に変わる,チョーイケてるライブラリで,すんごくて,すんごいのですが,Lazy IOの悪口をいっぱい書くのはかったるいので詳しく言いません.

tweetGen関数は,Requestとストリームのシンク(Twitterからやってくる返答をどう処理するのか)とを引数にとって,m oを返します.
たとえば,tweetGen req CL.sinkNull :: IO ()などします.

まず,do内1行目でmanagerを発行しています.http関数に渡します.
2行目signOAuth関数でreq :: Requestに作成したOAuth/Credentialをくっつけます.
3行目からは普通に,http関数でResponse bodyを得て,4行目でsinkと接合し,流します.

とりあえず,つぶやいてみますか.

つぶやく

つぶやくためには,次のことが必要です.

以上です.

parseUrlPost :: MonadThrow m => [(BS.ByteString,BS.ByteString)] -> String -> m Request
parseUrlPost post = return . urlEncodedBody post <=< parseUrl

tweetNow1 :: String ->  IO ()
tweetNow1 st = runResourceT $ do
  req <- liftIO $ parseUrlPost
    [("status", BS8.pack . UTF8.encodeString $ st)]
    "https://api.twitter.com/1.1/statuses/update.json"
  tweetGen req CL.sinkNull
  return ()

いいわすれていました.
実は,HaskellのparseUrl関数はURLを渡すとRequest型を返してくるのですが,これはGET送信用です.
POST送信にするには,urlEncodedBody :: [(BS8.ByteString, BS8.ByteString)] -> Request -> Request関数を用いなければなりません.1つ目の引数はおさっしの通りPOSTするプロパティとその値です.
POST送信用のRequestを作るparseUrlPost関数をそういうノリで定義しています.
ただし,プロパティもその値もUTF8でエンコードしたあとByteStringにする必要があることに注意してください.
tweetNow1関数は先のtweetGen関数を用いて定義しています.Data.Conduit.List.sinkNull関数はドブに捨てるシンクです.

さて,つぶやいてみましょう.
tweetNow1の引き数はおまじないですので,ぜったいにこれでツイートしてください.

main :: IO ()
main = do
  tweetNow1 "くるぶしと酒飲みにいきてえ!"

ぱーすじゃーい

さて,次は,ツイートを監視してみましょう.

実は,TwitterAPIには,ストリームうんぬんとかいうそれ的なやつがあります.
普通のAPIは,「タイムライン見せて!->いいよ->タイムライン見せて!->いいよ->タイムライン見せて!->いいよ!->タイムライン見せて!->うるちゃいうるちゃいうるちゃーい!!」
と,なるのですが,ストリームうんぬんだと,「タイムライン見せて!->いいよーーーーーーーーーーーー...」と,コネクションが永遠に張られ(切断されないように定期的に無意味な改行がくる),タイムラインが更新されるたびに文字列がやってくるようになります.
これを処理するためには,文字列を遅延してパースし処理する必要があります.
ので,Conduitを使いましょう!Conduitは,$$関数で接合された中であればいいかんじのノリで遅延してリソースの管理とかもしてくれます.

とりあえず,パースするところから初めましょう.
TwitterAPIから送られてくるデータはJSONです.JSONをオレオレTweet型に変換したいですね.
TwitterAPIから送られてくるJSONのパラメターについては,公式のドキュメントを見てください.
ここから自分が欲しいデータについてだけをオレオレ型に組込みます.
たとえば,次のように.

data Tweet = Tweet {
  id_str :: Text,
  text :: Text,
  user :: TwitterUser,
  retweeted_status :: Maybe Tweet,
  in_reply_to_screen_name :: Maybe Text
} deriving (Show, Eq)
instance FromJSON Tweet where
  parseJSON = withObject "tweet" $ \o -> do
    id_str <- o .: "id_str"
    text <- o .: "text"
    user <- o .: "user"
    retweeted_status <- o .:? "retweeted_status"
    in_reply_to_screen_name <- o .:? "in_reply_to_screen_name"
    return Tweet{..}

data TwitterUser = TwitterUser {
  screen_name :: Text
} deriving (Show, Eq, Generic)
instance FromJSON TwitterUser

Tweetがオレオレ型です.

  • id_str
    このツイートの識別子

  • text
    このツイートの本文

  • user
    このツイートのつぶやき元

  • retweeted_status
    このツイートのリツイート元

  • in_reply_to_screen_name
    このツイートのリプライ先

retweeted_statusin_reply_to_screen_nameに注目してください.
Maybe a型になっています.
これは,JSONの中にあるかもしれないし,ないかもしれないパラメタだからです.
Maybe a型にすることによって,その意味を表現することができます.
また,userretweeted_statusに注目してください.
ここでは,オレオレ型TwitterUser型を指定したり,再帰的にTweet型を指定したりしています.こういうこともできるわけです.とても直観的です.
Haskellっていいですね.

ほんとうは,Genericという型クラスとDeriveGenericプラグマをつかうとこのインスタンス定義は自動でできるのですが,
Maybeとかまではできないっぽいので,手動で定義しています.

FromJSON型クラスは,parseJSON :: Value -> Parse a関数をサポートします.
これは,JSON専用の型Valueから型aへの変換Parse aを返す関数だと思ってください.
withObject関数にObject -> Parse aを渡すことでつくれます.
.:関数はObjectText(これはプロパティ名)をとってParser aを返します.
.:?関数はObjectTextをとってParser (Maybe a)を返します.そのプロパティがない場合はNothing,ある場合はJustというノリです.(0.11未満のバージョンではプロパティがない場合とあるけどnilの場合とでの挙動の違いがありゴミです.注意.).
Parser aはモナドなので,束縛するとaが残ります.
parseJSONの定義では,それぞれ束縛したあと,Tweet{..}で束縛したものを打ち込んだTweet型のデータを返しています.
{..}はレコードの省略で,レコード名に該当する束縛あるいは定義された引き数を打ち込んで勝手につくってくれます.RecordWildCardsプラグマによる効果です.

さて,パーサーができました!
これで,JSONからオレオレ型に変換できます!

ツイートに対しての動作を書いてみよう!

さて,オレオレツイート型にパースできるわけなので,
オレオレツイート型を引き数にしたアクションを返す関数を書いてみましょう.

とりあえず,指定したモジレツがあれば,ふぁぼしてみましょう.

type TweetID = BS.ByteString

favoList :: [Text]
favoList = ["アマガミ" ,"トミカ"]

favoExec :: TweetID -> IO ()
favoExec twid = runResourceT $ do
  req <- liftIO $ parseUrlPost [("id", twid)] "https://api.twitter.com/1.1/favorites/create.json"
  tweetGen req CL.sinkNull
  return ()

takeTweetFavo :: (MonadIO m, MonadThrow m) => Tweet -> m ()
takeTweetFavo tw = do
  liftM (fromMaybe ()) . runMaybeT $ do
    let user' = screen_name . user $ tw
    let text' = text $ tw
    let re' = id_str $ tw
    guard $ retweeted_status tw == Nothing
    guard $ any (`T.isInfixOf` text') favoList
    liftIO $ T.putStrLn ("@"<>user'<>" "<>text')
    liftIO $ favoExec (T.encodeUtf8 re')
    liftIO $ putStrLn ("\t==> favo!")
    return ()

うーん.ていすてぃー.
ふぁぼは,投稿と同じノリでできます.
favorites/create.jsonへパラメタidにTweetIDをぶちこんでPOST送信です.
favoExec関数は,Tweet型を引数にとってふぁぼするアクションを返します.
user', text',re'`はそれぞれTweet型のレコードをとります.
さて,次の場面ではファボしたくありません.

  • リツイートしたぞという情報

  • favoListに関係ないツイート

これらのときは,すぐさま処理をやめたいです.
そんなときは,guard関数です!
guard関数はAlternative f => Bool -> f (),で,つまりはBool値をとってモナドっぽい(語弊がある)f ()を返します.特に,f=MaybeT mのとき,Bool -> MaybeT m ()となり,False -> m (Nothing)となります!
つまり,guard関数で処理を失敗させてNothingにして処理を終わりにできます.
さて,あとは,T.putStrLnなどでコンソールにお知らせをしたり,favoExecでふぁぼりましょう.これらは,IO aなのでliftIO関数でm aとするのを忘れずに.
結局,do内は,liftIOできて,Alternativeなモナドなので,MaybeT IO ()と解釈することにしましょう.
liftM (fromMaybe ()) . runMaybeT :: MaybeT m () -> m ()となります.
fromMaybe関数はMaybe a -> aNothingのときのデフォルト値を定めます.ここでは()です.

監視しよう!

さて,監視をはじめましょう.

twitterUserStreamURL :: URL
twitterUserStreamURL = "https://userstream.twitter.com/2/user.json"

takeTweetLoop :: (MonadIO m, MonadThrow m) => Sink BS.ByteString m ()
takeTweetLoop = do
  val <- CA.sinkParser json
  case (fromJSON val :: Result Tweet) of
    Success tw ->
      mapM_ ($tw) [takeTweetFavo]
    Error st -> return ()
  takeTweetLoop

main :: IO ()
main = forever $ runResourceT $ do
  req <- liftIO $ parseUrl $ twitterUserStreamURL
  tweetGen req takeTweetLoop
  return ()

さて,いいわすれていましたが,自分のタイムラインをストリームでとってくるときは,user.jsonへアクセスします.
先のtweetGen関数に,twitterUserStreamURLへのリクエストとtakeTweetLoopというシンクを渡し,動作させます!ふぁぼがはじまりますよ!

takeTweetLoopはストリームのシンクです.よって型は,Sink BS.ByteString m ()です.
定義を見てみましょう.
CA.sinkParser関数はチョークールです.
パースする内容(json,これは定義されているデータ)を渡すと,
それをパースしパースした結果を返すシンクとなります!クール!
型は,Attoparsec.Internal.Parser a b -> ConduitM a o m bです.
このParserは,先のAesonのParserとは関係ないので注意してください.
json :: Attoparsec.ByteString.Internal.Parser Valueなので,この場合sinkParser json :: ConduitM BS.ByteString o m Valueとなり,o=VoidとすればsinkParser json :: Sink BS.ByteString m Valueと見れます!
Sink BS.ByteString mまでがモナドです!
さて,よって,val :: Valueとなりますね.これをfromJSON :: Value -> Result aでパースしましょう.aFromJSON型クラスのインスタンスです.さっき定義しましたね!やった!
さて,ResultEitherのようなものです.成功時のSuccessと失敗のErrorがあります.caseで場合分けしましょう.
mapM_ f [x,y,z]f x >> f y >> f z >> return ()のような結果となります.
ここでは,Tweet型にパース成功時のみ,takeTweetFavo関数に回すようにしていますよ.

設定ファイルをよもう!

ここからは,あとで,いろいろもじかく.
なんかもうあきてきたんだよ!

ConfigFileライブラリつかうと,OAuthを設定ファイルからよみこめるようになるよ!
読み込んだものは、OAuthEnv型で表現し、Tweetを読んで動作するもろもろはMonadReader OAuthEnv mをつかって
OAuthEnvを環境とするモナドだよって表現しよう。

ついでに、いろいろ定義しなおしたり、追加で定義するよ。

data OAuthEnv = OAuthEnv {
  getOAuth :: OAuth
, getCredential :: Credential
}

makeOAuthEnv :: FilePath -> IO OAuthEnv
makeOAuthEnv file = do
  val <- readfile emptyCP{optionxform = id} file
  let cp = forceEither val
  let oauthCK = forceEither $ get cp "OAuth" "ConsumerKey"
  let oauthCS = forceEither $ get cp "OAuth" "ConsumerSecret"
  let credentialAT = forceEither $ get cp "Credential" "AccessToken"
  let credentialATS = forceEither $ get cp "Credential" "AccessTokenSecret"
  let oauth = newOAuth {
    oauthRequestUri = "https://api.twitter.com/oauth/request_token",
    oauthAccessTokenUri = "https://api.twitter.com/oauth/access_token",
    oauthAuthorizeUri = "https://api.twitter.com/oauth/authorize",
    oauthConsumerKey = BS8.pack oauthCK,
    oauthConsumerSecret = BS8.pack oauthCS}
  let credential = newCredential (BS8.pack credentialAT) (BS8.pack credentialATS)
  return $ OAuthEnv {
    getOAuth = oauth
  , getCredential = credential}

tweetGen :: (MonadIO m, MonadThrow m, MonadResource m, MonadReader OAuthEnv m) =>
  Request -> Sink BS.ByteString m o -> m o
tweetGen req sink = do
  oauth <- liftM getOAuth $ ask
  credential <- liftM getCredential $ ask
  manager <- liftIO $ newManager conduitManagerSettings
  signedRequest <- signOAuth oauth credential req
  res <- http signedRequest manager
  responseBody res $$+- sink

tweetNow :: String -> ReaderT OAuthEnv IO ()
tweetNow st = runResourceT $ do
  req <- liftIO $ parseUrlPost
    [("status", BS8.pack . UTF8.encodeString $ st)]
    "https://api.twitter.com/1.1/statuses/update.json"
  tweetGen req CL.sinkNull
  return ()

tweetRep :: String -> TweetID -> ReaderT OAuthEnv IO ()
tweetRep st toReply = runResourceT $ do
  req <- liftIO $ parseUrlPost
    [("status", BS8.pack . UTF8.encodeString $ st), ("in_reply_to_status_id", BS8.pack . show $ toReply)]
    "https://api.twitter.com/1.1/statuses/update.json"
  tweetGen req CL.sinkNull
  return ()

watcher :: (MonadIO m, MonadThrow m) => Tweet -> m ()
watcher tw = do
  liftM (fromMaybe ()) . runMaybeT $ do
    let ids = id_str $ tw
    let user' = screen_name . user $ tw
    let text' = text $ tw
    let re' = id_str $ tw
    liftIO $ T.putStrLn ("@"<>user'<>": "<>ids<>"\n"<>text')
    return ()

takeTweetLoop :: (MonadIO m, MonadThrow m) => [Tweet -> m ()] -> Sink BS.ByteString m ()
takeTweetLoop acts = do
  val <- CA.sinkParser json
  case (fromJSON val :: Result Tweet) of
    Success tw -> lift $ mapM_ ($tw) acts
    Error st   -> return ()
  takeTweetLoop acts

filterWatch :: [String] -> ReaderT OAuthEnv IO ()
filterWatch sts = runResourceT $ do
  req <- liftIO $ parseUrl . addFilterWords sts $
    "https://stream.twitter.com/1.1/statuses/filter.json"
  tweetGen req (takeTweetLoop [watcher])

addFilterWords :: [String] -> URL -> URL
addFilterWords sts url = url ++ "?track=" ++ sts'
  where sts' = L.intercalate "," sts

timeLineWatch :: ReaderT OAuthEnv IO ()
timeLineWatch = runResourceT $ do
  req <- liftIO $ parseUrl
    "https://userstream.twitter.com/2/user.json"
  tweetGen req (takeTweetLoop [watcher])

コマンド化するよ!

もう,あきてきたよ!

getOptcmdargsoptparse-applicativeをつかうと,簡単にコマンド化できるよ!
ここでは,optparse-applicativeをつかってみるよ!

オプションのデフォルト値は,MyEnv型で表現するよ!環境によってかわるものだから,IO MyEnvしよう!

data MyEnv = MyEnv {
  askHomeDir :: FilePath
}

makeMyEnv :: IO MyEnv
makeMyEnv = do
  askHomeDir <- getHomeDirectory
  return MyEnv{..}

data Options = PostOptions {
  optRepID :: Maybe Integer
, optConfigFilePath :: FilePath
, optText :: String
} | FilterOptions {
  optConfigFilePath :: FilePath
, optWords :: [String] 
} | TimeLineOptions {
  optConfigFilePath :: FilePath
} deriving (Show, Eq)

oauthOption = option str
  ( long "oauth"
     <> metavar "FILE"
     <> value ((askHomeDir env)++"/.myclient/oauth.conf") --default
     <> help "OAuth config file")

postOP :: MyEnv -> Parser Options
postOP env = PostOptions
    <$> optional (option auto
      ( long "reply"
     <> short 'r'
     <> metavar "INT"
     <> help "which TweetID in reply to"))
    <*> oauthOption
    <*> argument str
      ( metavar "TEXT")

filterOP :: MyEnv -> Parser Options
filterOP env = FilterOptions
    <$> oauthOption
    <*> some (argument str
      ( metavar "WORD..."))

timeLineOP :: MyEnv -> Parser Options
timeLineOP env = TimeLineOptions
    <$> oauthOption

allOptions :: MyEnv -> Parser Options
allOptions env = subparser $
    command "post" (info (postOP env)
      (progDesc "Post your tweet."))
 <> command "filter" (info (filterOP env)
      (progDesc "Watch tweets filterd."))
 <> command "tl" (info (timeLineOP env)
      (progDesc "Watch your timeline."))

addInfo :: (MyEnv -> Parser Options) -> (MyEnv -> ParserInfo Options)
addInfo parser env = info
  (helper <*> parser env)
  (fullDesc
    <> progDesc "Tweet"
    <> header "Let's tweet")

getOptions :: IO Options
getOptions = do
  env <- makeMyEnv
  execParser . addInfo allOptions $ env

すごい細かいことをいうと,option autoはパースする関数をshowDefaultWith(レコード)で指定しない限りshowなので,
Stringをパースすると,"がジャマだよ.だから,showDefaultWith = idとするかoption str == strOptionをつかうよ.

で,

exec :: Options -> IO ()
exec (PostOptions {..}) = do
  let (tw, oauthFilePath) = (optText, optConfigFilePath)
  oauthEnv <- makeOAuthEnv oauthFilePath
  case optRepID of
    (Just id) -> runReaderT (tweetRep tw id) oauthEnv
    Nothing   -> runReaderT (tweetNow tw   ) oauthEnv
exec (FilterOptions {..}) = do
  let (sts, oauthFilePath) = (optWords, optConfigFilePath)
  oauthEnv <- makeOAuthEnv oauthFilePath
  case sts of
    (_:_) -> runReaderT (filterWatch sts) oauthEnv
    []    -> return () 
exec (TimeLineOptions {..}) = do
  let (tw, oauthFilePath) = (optText, optConfigFilePath)
  oauthEnv <- makeOAuthEnv oauthFilePath
  runReaderT timeLineWatch oauthEnv

main ::  IO ()
main = do
  opts <- getOptions
  exec opts

結論

  • Markdownかきやすいので,よい.

  • Haskell,ドキュメントちゃんと読めなくても,日本語文献なくても,型さえわかれば,何するのかノリで分かるのですき.

  • Haskell,同じく,最悪ライブラリのコード読めばなにしているか分かるのですき.

  • Haskell,キモチやノリを型クラスに込めて,その場では具体的な型を保留して関数定義できるのですき.

  • いろいろライブラリつかうなら,Stackつかわないと,キツい.cabalつかってたらしぬ.Stackつかうと,すごい楽.

  • いっぱい文字かいてるとあきちゃう.

kurubushi/tweeter_on_haskell (最終更新日時 2016-03-01 13:22:56 更新者 kurubushi)