ffeed 0.2 → 0.3

raw patch · 5 files changed

+244/−1 lines, 5 filesdep ~basenew-component:exe:tweetStream

Dependency ranges changed: base

Files

• FriendFeed/Monad.hs +19/−0
• FriendFeed/Types.hs +16/−0
• FriendFeed/Updates.hs +51/−0
• examples/TweetStream.hs +150/−0
• ffeed.cabal +8/−1

@@ -105,6 +105,21 @@  type ErrM a = Either FFeedErr a +ffeedTranslateSub :: JSON a => String -> FFm String -> FFm a+ffeedTranslateSub l a = do+  vs <- a+  case runGetJSON readJSObject vs of+    Right (JSObject (JSONObject os)) ->+     case lookup l os of+       Just x -> dec vs x+       _ -> liftIO (throwIO (toException FFeedErr{ffErrorCode="translate-error-field-missing-"++l, ffErrorLoc = (Just l), ffErrorSource = vs}))+    _ -> liftIO (throwIO (toException FFeedErr{ffErrorCode="translate-error-field-missing-"++l, ffErrorLoc = (Just l), ffErrorSource = vs}))+ where+  dec vs x = +   case readJSON x of+     Error e -> liftIO (throwIO (toException FFeedErr{ffErrorCode="translate-error-"++l, ffErrorLoc = (Just e), ffErrorSource = vs {-showJSValue x ""-}}))+     Ok s    -> return s+ ffeedTranslateLs :: JSON a => String -> FFm String -> FFm [a] ffeedTranslateLs l a = do   vs <- a@@ -173,6 +188,10 @@ mbArg :: String -> Maybe String -> [String] -> [String] mbArg _ Nothing xs = xs mbArg x (Just y) xs = (x++'=':encodeString y):xs++mbArg2 :: String -> Maybe String -> [(String,String)] -> [(String,String)]+mbArg2 _ Nothing xs = xs+mbArg2 x (Just y) xs = (x,y):xs  lsArg :: String -> String -> [String] -> [String] lsArg _ [] xs = xs

@@ -22,6 +22,7 @@ type ListName = String type RoomName = String type ServiceName = String+type UpdateToken = String  type EntryID   = UUID type CommentID = UUID@@ -278,4 +279,19 @@      , listURL      = ""      , listUsers    = []      , listRooms    = []+     }++data UpdateInfo+ = UpdateInfo+     { updToken      :: UpdateToken+     , updInterval   :: Integer+     , updIncomplete :: Bool+     }++nullUpdateInfo :: UpdateInfo+nullUpdateInfo + = UpdateInfo+     { updToken      = ""+     , updInterval   = 40+     , updIncomplete = False      }

@@ -0,0 +1,51 @@+module FriendFeed.Updates where
+
+import FriendFeed.Types
+import FriendFeed.Types.Import ()
+import FriendFeed.Monad
+
+upd_base :: URLString
+upd_base = "http://chan.friendfeed.com/api/updates/"
+
+upd_base2 :: URLString
+upd_base2 = "http://chan.friendfeed.com/api/updates"
+
+getUpdateInfo :: FFm UpdateInfo
+getUpdateInfo = withBase upd_base2 $ authCall $
+  ffeedTranslateSub "update" $ 
+    ffeedCall [""] []
+
+-- | Returns updates to the users home feed.
+getUpdatesHome :: UpdateToken -> Maybe Int -> FFm [Entry]
+getUpdatesHome tok mbT = withBase upd_base $ authCall $
+  ffeedTranslateLs "entries" $ 
+    ffeedCall ["home"] 
+              (mbArg2 "timeout" (fmap show mbT) $
+	       mbArg2 "token"   (Just tok) [])
+
+-- | Returns updates to a user's friends. 
+getUpdatesFriends :: UserName -> UpdateToken -> Maybe Int -> FFm [Entry]
+getUpdatesFriends u tok mbT = withBase upd_base $ authCall $
+   ffeedTranslateLs "entries" $
+    ffeedCall ["user",u,"home"] 
+              (mbArg2 "timeout" (fmap show mbT) $
+	       mbArg2 "token"   (Just tok) [])
+
+-- | Returns updates to the authenticated user's list with the given nickname.
+getUpdatesList :: ListName -> UpdateToken -> Maybe Int -> FFm [Entry]
+getUpdatesList l tok mbT = withBase upd_base $ authCall $
+   ffeedTranslateLs "entries" $
+    ffeedCall ["list",l] 
+              (mbArg2 "timeout" (fmap show mbT) $
+	       mbArg2 "token"   (Just tok) [])
+
+-- | Returns updates to the room with the given nickname. 
+getUpdatesRoom :: RoomName -> UpdateToken -> Maybe Int -> FFm [Entry]
+getUpdatesRoom r tok mbT = withBase upd_base $ authCall $
+   ffeedTranslateLs "entries" $
+    ffeedCall ["room",r] 
+              (mbArg2 "timeout" (fmap show mbT) $
+	       mbArg2 "token"   (Just tok) [])
+
+
+

@@ -0,0 +1,150 @@+{-
+  Demonstrates how to use the FriendFeed API by querying
+  for the most recent public entries collected by FriendFeed.
+  
+  The API interaction happens in @showPublic@, with 
+  @presentEntries@ outputting the results. The rest is option
+  handling stuff + startup and shutdown code in @main@.
+  
+  Example command-line invocation:
+  
+  foo$ showPublic -u <your-username> -k <remote-key> \
+         -s twitter -l 2
+  
+  showing the last 2 public tweets.
+
+  where <your-username> and <remote-key> is your FriendFeed auth
+  setup. Your remote key can be located here:
+  
+     http://friendfeed.com/remotekey
+  
+  However, since this example presently uses public methods not
+  needing authentication, any old username/key combo will work.
+  [Top tip: try leaving them out..]
+
+  The @-s@ option constrains the entries from a given FriendFeed-supported
+  service. @-l@ limits the length to given size (default: 30.)
+-}
+module Main(main) where
+
+import FriendFeed.API
+import FriendFeed.Updates
+
+import Util.GetOpts
+import System.IO
+import System.Environment
+import System.Exit
+
+import Control.Monad
+import Control.Concurrent
+import Data.Maybe ( fromMaybe, isJust )
+
+-- main functions for grabbing public entries + 
+-- presenting them to the user:
+getUpdateStream :: Maybe String -> Maybe Int -> Bool -> RoomName -> UpdateToken -> FFm [Entry]
+getUpdateStream mbS mbL isList r tok = 
+  (fromMaybe id (fmap forService   mbS)) $
+  (fromMaybe id (fmap withPageSize mbL)) $
+    (if isList then getUpdatesRoom else (if r == "home" then const getUpdatesHome else getUpdatesList)) r tok (Just 3)
+
+presentEntries :: [Entry] -> IO ()
+presentEntries [] = putStrLn "No public entries found!"
+presentEntries xs = do
+  putStrLn ("Most recent public entries: ")
+  mapM_ presentEntry xs
+ where
+  presentEntry e = 
+    putStrLn $ unlines
+      [ "---"
+      , " Title: " ++ entryTitle e
+      , " Link:  " ++ entryLink e
+      , " User:  " ++ resourceName (entryUser e)
+      ]
+
+
+-- start option handling
+
+data Options
+ = Options
+    { optUser    :: Maybe String
+    , optKey     :: Maybe String
+    , optSize    :: Maybe Int
+    , optService :: Maybe String
+    , optRoom    :: Maybe String
+    , optList    :: Maybe String
+    }
+
+nullOptions :: Options
+nullOptions = Options
+    { optUser     = Just ""
+    , optKey      = Just ""
+    , optSize     = Nothing
+    , optService  = Nothing
+    , optRoom     = Nothing
+    , optList     = Nothing
+    }
+     
+option_descr :: [OptDescr (Options -> Options)]
+option_descr = 
+  [ Option ['u'] ["user"]
+           (ReqArg (\ x o -> o{optUser=Just x}) "USER")
+	   "user name to authenticate as"
+  , Option ['k','p'] ["key","remote-key"]
+           (ReqArg (\ x o -> o{optKey=Just x}) "REMOTE KEY")
+	   "the user's FriendFeed remote key"
+  , Option ['l'] ["length"]
+           (ReqArg (\ x o -> o{optSize=Just (read x)}) "SIZE")
+	   "fetch SIZE entries"
+  , Option ['s'] ["service"]
+           (ReqArg (\ x o -> o{optService=Just x}) "SERVICE")
+	   "limit query to given service name"
+  , Option ['r'] ["room"]
+           (ReqArg (\ x o -> o{optRoom=Just x}) "ROOM")
+	   "get continual updates from the given room"
+  , Option ['L'] ["list"]
+           (ReqArg (\ x o -> o{optRoom=Just x}) "LIST")
+	   "get continual updates from the given list (personal,favorites,etc.)"
+  ]
+
+parseOptions :: [String] -> (Options, [String], [String])
+parseOptions argv = getOpt2 Permute option_descr argv nullOptions
+
+processOptions :: IO Options
+processOptions = do
+  ls <- getArgs
+  let (opts, ws, es) = parseOptions ls
+  when (not $ null ws) $ do
+    hPutStrLn stderr "Command-line warnings: " 
+    hPutStrLn stderr (unlines ws)
+  when (not $ null es) $ do
+    hPutStrLn stderr (unlines es)
+    hPutStrLn stderr ("(try '--help' for list of options supported.)")
+    exitFailure
+  return opts
+
+-- end option handling
+
+main :: IO ()
+main = do
+  opts <- processOptions
+  case (optUser opts, optKey opts) of
+    (Just u,Just k) -> do
+       t  <- runFF u k (getUpdateInfo)
+       let
+        r   = fromMaybe (if isL then ls else "haskell") (optRoom opts)
+        ls  = fromMaybe "home" (optRoom opts)
+	isL = isJust (optList opts)
+        loopIt = do
+	   putStrLn "sampling.." 
+	   hFlush stdout
+           xs <- runFF u k (getUpdateStream (optService opts) (optSize opts) isL r (updToken t))
+           presentEntries xs
+	   hFlush stdout
+	   threadDelay (fromIntegral (updInterval t * 1000 * 1000))
+	   loopIt
+
+       loopIt
+
+    _ -> do
+       putStrLn ("Both user and remote-key options are required.")
+       return ()

@@ -1,5 +1,5 @@ name: ffeed
-version: 0.2
+version: 0.3
 synopsis: Haskell binding to the FriendFeed API
 description:
    The hs-ffeed API binding lets you access friendfeed.com's
@@ -34,6 +34,7 @@                   FriendFeed.Search,
                   FriendFeed.Service,
                   FriendFeed.Subscribe,
+                  FriendFeed.Updates,
                   FriendFeed.User,
                   Util.Codec.Percent,
                   Util.Codec.URLEncoder,
@@ -55,5 +56,11 @@ executable showPublic {
   build-depends:        base, pretty
   main-is:              examples/ShowPublic.hs
+  ghc-options:          -Wall -fglasgow-exts -iexamples
+}
+
+executable tweetStream {
+  build-depends:        base, pretty
+  main-is:              examples/TweetStream.hs
   ghc-options:          -Wall -fglasgow-exts -iexamples
 }