Browse files

Cleanup, get rid of space leak, utility functions for iterating

without iteratees explicitly.
  • Loading branch information...
1 parent 6d0fe47 commit 7330909a025e55089ae1474df1f96b360b5231ef @mariusae committed Jul 25, 2010
Showing with 57 additions and 54 deletions.
  1. +20 −1 Web/TwitterStream.hs
  2. +33 −32 Web/TwitterStream/Iteratee.hs
  3. +4 −0 Web/TwitterStream/Types.hs
  4. +0 −21 stream.hs
View
21 Web/TwitterStream.hs
@@ -1,8 +1,27 @@
module Web.TwitterStream
- ( module Web.TwitterStream.Types
+ ( Status(..)
+ , foreachStatus
+ , foreachStatusInFile
+ , module Web.TwitterStream.Types
, module Web.TwitterStream.Iteratee
) where
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Iteratee as I
+
import Web.TwitterStream.Types
import Web.TwitterStream.Iteratee
+import Web.Twitter.Types (Status(..))
+
+foreachStatus :: Auth -> Stream -> (ParsedStatus -> IO a) -> IO ()
+foreachStatus auth stream m = driver auth stream (iterIO m)
+
+foreachStatusInFile :: FilePath -> (ParsedStatus -> IO a) -> IO ()
+foreachStatusInFile path m = I.fileDriver (iterIO m) path
+iterIO m = do
+ st <- status
+ liftIO $ m st
+ case st of
+ EOF -> return ()
+ _ -> iterIO m
View
65 Web/TwitterStream/Iteratee.hs
@@ -5,57 +5,58 @@ module Web.TwitterStream.Iteratee
import Prelude hiding (catch)
import Control.Monad.IO.Class
-import Control.Concurrent.MVar (newMVar, modifyMVar_)
+import Control.Concurrent.MVar (newMVar, readMVar, modifyMVar_)
import Control.Exception (catch, SomeException(..))
+import Control.Monad (liftM)
-- for the JSON instance:
import Web.Twitter.Types.Import ()
-import qualified Data.Iteratee as Iter
-import qualified Data.Iteratee.Char as IterChar
-import qualified Network.Curl as Curl
import Web.Twitter.Types (Status(..))
-import Text.JSON (decode, Result(..))
+import qualified Data.Iteratee as I
+import qualified Data.Iteratee.Char as IC
+import qualified Network.Curl as Curl
+import qualified Text.JSON as Json
import Web.TwitterStream.Types
url :: Stream -> [Char]
url Sample = "http://stream.twitter.com/1/statuses/sample.json"
url Firehose = "http://stream.twitter.com/1/statuses/firehose.json"
-driver :: Auth -> Stream -> Iter.IterateeG [] Char IO a -> IO ()
+driver :: Auth -> Stream -> I.IterateeG [] Char IO a -> IO a
driver (BasicAuth username password) stream iterStart = Curl.withCurlDo $ do
- iter <- newMVar iterStart
-
- let recvChunk chunk = modifyMVar_ iter $ \iter' -> do
- cont <- Iter.runIter iter' (Iter.Chunk $ chunk)
- case cont of
- -- TODO - actually handle the cases here.
- Iter.Done x _ -> return $ Iter.IterateeG $ return . Iter.Done x
- Iter.Cont next _ -> return next
-
+ iterMV <- newMVar iterStart
h <- Curl.initialize
Curl.setopts h
- [ Curl.CurlFailOnError True
- , Curl.CurlURL $ url stream
- , Curl.CurlUserPwd $ username ++ ":" ++ password
- , Curl.CurlHttpAuth [Curl.HttpAuthAny]
- , Curl.CurlWriteFunction $ Curl.callbackWriter recvChunk ]
+ [ Curl.CurlFailOnError $ True
+ , Curl.CurlURL $ url stream
+ , Curl.CurlUserPwd $ username ++ ":" ++ password
+ , Curl.CurlHttpAuth $ [Curl.HttpAuthAny]
+ , Curl.CurlWriteFunction $ Curl.callbackWriter (iterChunk iterMV) ]
Curl.perform h
- return ()
-
-status :: (Monad m, MonadIO m) => Iter.IterateeG [] Char m (Maybe Status)
+ I.run =<< readMVar iterMV
+ where
+ iterChunk iterMV chunk = modifyMVar_ iterMV $ \iter -> do
+ cont <- I.runIter iter (I.Chunk $ chunk)
+ case cont of
+ -- TODO - actually handle the cases here.
+ I.Done x _ -> return $ I.IterateeG $ return . I.Done x
+ I.Cont next _ -> return next
+
+status :: (Monad m, MonadIO m) => I.IterateeG [] Char m ParsedStatus
status = do
- someLine <- IterChar.line
+ someLine <- IC.line
case someLine of
- Left _ -> return Nothing
- Right l ->
- liftIO $
- catch (decodeStatus l)
- (const $ return Nothing :: SomeException -> IO (Maybe Status))
+ Left _ -> return EOF
+ Right l -> liftIO $ safeDecodeStatusIO l
+safeDecodeStatusIO line = catch (decodeStatus line) nothing
where
decodeStatus line = do
- case decode line of
- Ok status' -> return $ Just status'
- Error _ -> return Nothing
+ case Json.decode line of
+ Json.Ok status' -> return $ Ok line status'
+ Json.Error _ -> return $ Error line
+
+ nothing :: SomeException -> IO ParsedStatus
+ nothing = const $ return $ Error line
View
4 Web/TwitterStream/Types.hs
@@ -1,7 +1,11 @@
module Web.TwitterStream.Types
( Auth(..)
, Stream(..)
+ , ParsedStatus(..)
) where
+import Web.Twitter.Types (Status(..))
+
data Auth = BasicAuth String String -- username, password
data Stream = Sample | Firehose
+data ParsedStatus = Ok String Status | Error String | EOF
View
21 stream.hs
@@ -1,21 +0,0 @@
-module Main where
-
-import Data.Maybe
-import Control.Monad.IO.Class
-import Control.Monad (forever, when)
-import System (getArgs)
-import Web.Twitter.Types (Status(..))
-
-import qualified Web.TwitterStream as Stream
-import qualified Data.Iteratee as Iter
-
-main = do
- u : p : _ <- getArgs
-
- Stream.driver (Stream.BasicAuth u p) Stream.Sample $ forever $ do
- s <- Stream.status
- when (isJust s) $ do
- liftIO $ f (fromJust s)
-
- where
- f tweet = putStrLn $ statusId tweet

0 comments on commit 7330909

Please sign in to comment.