bigsleepの日記

 | 

2014-05-05

extensible-effectsでクライアント

20:12

extensible-effectsのエフェクトを自分で書いてみる練習でhttpのclientをエフェクトとして書いてみました。

Lift IOがあれば、これがなくても普通にhttp-clientは使えるんですがクライアント部分の挙動を差し替えたりしたいときなどには使えるかもしれません。

  • dataの宣言でFunctorとDypeableをderivingする
  • Eff r a の値を作る関数を用意する
  • runなんとかという名前の実行するための関数を用意する

という感じのものが必要みたいです。

2番目と3番目のがちょっと慣れないと書き方が難しい感じがしました。


{-# LANGUAGE TypeOperators, FlexibleContexts, DeriveDataTypeable, DeriveFunctor #-}

import Control.Eff ((:>), VE(..), Eff, Member, SetMember, admin, handleRelay, inj, send)
import Control.Eff.Lift (Lift, lift, runLift)

import Data.Typeable
import qualified Data.ByteString.Lazy as L (ByteString)
import qualified Network.HTTP.Client as N (Request(..), Response(..), newManager, defaultManagerSettings, httpLbs, parseUrl)

data HttpClient a = HttpClient N.Request (N.Response L.ByteString -> a) deriving (Typeable, Functor)

httpClient :: (Member HttpClient r) => N.Request -> Eff r (N.Response L.ByteString)
httpClient req = send $ \g -> inj (HttpClient req g)

runHttpClient :: (Member (Lift IO) r, SetMember Lift (Lift IO) r) => Eff (HttpClient :> r) a -> Eff r a 
runHttpClient eff = do
    m <- lift (N.newManager N.defaultManagerSettings)
    loop m . admin $ eff
    where loop _ (Val a) = return a 
          loop m (E u) = handleRelay u (loop m) $ 
                            \(HttpClient req f) -> lift (N.httpLbs req m) >>= loop m . f 

code :: Eff (HttpClient :> Lift IO :> ()) ()
code = do
    lift . putStrLn $ "start http client"

    req <- lift $ N.parseUrl "http://www.example.com"
    x <- httpClient req
    lift $ print x 

    req2 <- lift $ N.parseUrl "http://www.google.co.jp"
    y <- httpClient req2
    lift $ print y 

    lift . putStrLn $ "end http client"

main :: IO ()
main = runLift . runHttpClient $ code
 | 
Connection: close