hs-twitterarchiver 0.1 → 0.2
raw patch · 6 files changed
+185/−220 lines, 6 filesdep +pretty
Dependencies added: pretty
Files
- Archiver/Options.hs +0/−55
- Archiver/Twitter.hs +0/−97
- Archiver/Utils.hs +0/−46
- README.md +7/−2
- hs-twitterarchiver.cabal +17/−11
- hs-twitterarchiver.hs +161/−9
− Archiver/Options.hs
@@ -1,55 +0,0 @@-module Archiver.Options where--import System.Console.GetOpt-import System.Environment-import System.IO-import System.Exit---data Settings = TS {- twitterUsername :: String,- twitterPassword :: Maybe String,- fileName :: String,- sinceId :: Maybe Integer } deriving Show--defaultSettings = TS { - twitterUsername = "vyom",- twitterPassword = Nothing,- fileName = "vyom.json",- sinceId = Nothing }--options = [ Option "h" ["help"]- (NoArg- (\_ -> do prg <- getProgName- hPutStrLn stderr (usageInfo prg options)- exitWith ExitSuccess))- "Show help"- , Option "u" ["username"]- (ReqArg- (\arg opt -> return opt { twitterUsername = arg })- "vyom")- "Twitter Username"- , Option "f" ["filename"]- (ReqArg- (\arg opt -> return opt { fileName = arg })- "vyom.json")- "Filename"- , Option "p" ["password"]- (NoArg- (\opt -> do putStr "Enter Twitter Password : "- hFlush stdout- hSetEcho stdout False - password <- hGetLine stdin- hSetEcho stdout True- putStr "\n"- return opt { twitterPassword = Just password }))- "ask for password (private Twitter stream)"- ]--parseOptions = do args <- getArgs- -- Parse options, getting a list of option actions- let (actions, nonOptions, errors) = getOpt RequireOrder options args-- -- Here we thread startOptions through all supplied option actions- foldl (>>=) (return defaultSettings) actions-
− Archiver/Twitter.hs
@@ -1,97 +0,0 @@-module Archiver.Twitter where--import Archiver.Options-import Archiver.Utils--import Text.JSON-import Text.JSON.Types-import Text.JSON.String-import Text.JSON.Pretty--import Data.List--import Control.Applicative-import Control.Monad.Reader--data Tweet = Tweet { - tweetText :: String, - tweetCreatedAt :: String , - tweetId :: Integer } deriving Show---- Making Tweet typeclass of JSON to enable decode/encode-instance JSON Tweet where- showJSON (Tweet tweetText tweetCreatedAt tweetId) = makeObj [ ("text", showJSON tweetText),- ("created_at", showJSON tweetCreatedAt), - ("id", showJSON tweetId)]-- readJSON (JSObject obj) = let jsonObjAssoc = fromJSObject obj- mLookup a = maybe (fail $ "No such element: " ++ a) return . lookup a- lookupP p = mLookup p jsonObjAssoc >>= readJSON- in do i <- lookupP "id"- t <- lookupP "text"- c <- lookupP "created_at"- return $ Tweet t c i--twitterUrl = "http://twitter.com/"---- extract array of JSON values from a string-readJSONTweets tweetsJSONString = case runGetJSON readJSArray tweetsJSONString of- Right (JSArray xs) -> xs- _ -> []----- read twitter stream page by page-readTwitterStream page tweets- | page >= 21 = return tweets- | otherwise = do fullUrl <- constructFullUrl- tweetsJSON <- readJSONTweets <$> readContentsURL fullUrl- if not (null tweetsJSON)- then readTwitterStream (page + 1) (tweets ++ tweetsJSON)- else return tweets- where url username = twitterUrl ++ "statuses/user_timeline/" ++ username ++ ".json"-- queryParams = [("count", "200"), ("page", show page)]-- concatQueryStr params = intercalate "&" $ map (\(k,v) -> k ++ "=" ++ v) params-- querystring Nothing = concatQueryStr queryParams- querystring (Just tweetId) = concatQueryStr $ queryParams ++ [("since_id", show tweetId)]-- constructFullUrl = do username <- asks twitterUsername- sinceId <- asks sinceId- return $ url username ++ "?" ++ querystring sinceId---- read contents of URL w/ optional HTTP auth-readContentsURL url = do- liftIO $ putStrLn url- username <- asks twitterUsername- password <- asks twitterPassword - liftIO $ readContentsURLWithAuth url username password--- -- calculate latest id for since_id param-calculateSinceId pastTweets = if not (null pastTweets)- then- let (Ok tweetids) = forM pastTweets $ liftM tweetId . readJSON- in Just (maximum tweetids)- else Nothing-- --- get past tweets stored in file (if any)-getPastTweets :: ReaderT Settings IO [JSValue]-getPastTweets = do filename <- asks fileName- fileContents <- liftIO $ readContentsArchiveFile filename- return $ readJSONTweets fileContents----- read twitter stream-getRecentTweets :: ReaderT Settings IO [JSValue]-getRecentTweets = readTwitterStream 1 [] ----- write Tweets to file-writeTweetsToFile filename tweetsJSON = let (Ok tweets) = mapM readJSONTweet tweetsJSON- readJSONTweet :: JSValue -> Result Tweet- readJSONTweet = readJSON- tweetsString = render $ pp_value $ showJSON tweets -- Encoding to JSON- in writeToFile filename tweetsString
− Archiver/Utils.hs
@@ -1,46 +0,0 @@-module Archiver.Utils where--import Data.Maybe-import System.IO.Error--import Network.Browser-import Network.HTTP-import Network.URI-- --- File related functions--readContentsArchiveFile f = do result <- try (readFile f)- case result of- Right s -> do putStrLn "Reading archive file"- return s-- _ -> do putStrLn "Could not read archive file"- return ""--writeToFile filename tweetsString = do putStrLn "Writing to file"- writeFile filename tweetsString---- URL related functions--readContentsURLWithAuth url username password = - let nullHandler _ = return ()- in do (_u, resp) <- browse $ do setOutHandler nullHandler- checkAuth url username password- (request $ getRequest url)- case rspCode resp of- (2,_,_) -> return (rspBody resp)- _ -> fail ("Failed reading URL " ++ show url ++ " code: " ++ show (rspCode resp))---- checks if password is provided and sets HTTP auth for request-checkAuth url username password - | password == Nothing = return ()- | otherwise = do - ioAction $ putStrLn "Using HTTP Auth"- addAuthority auth -- add auth to request- where auth = AuthBasic {- auUsername = username,- auPassword = fromJust password,- auRealm = "",- auSite = fromJust $ parseAbsoluteURI url }-
README.md view
@@ -1,7 +1,8 @@ # Introduction -This script will access your Twitter stream and create a text file with all -the past tweets in JSON format.+This script will access your Twitter stream and create a text file with all+the past tweets in JSON format. It also supports updating of the text file in+subsequent runs. The Twitter API currently limits access to a maximum of 3200 tweets in your timeline. Hence if you have tweeted more often than that, you will not be able@@ -22,6 +23,10 @@ when `hs-twitterarchiver` is called without any arguments. runhaskell twitterarchiver.hs -u vyom -f vyom.json++If a file called `vyom.json` already exists from a previous run, only the+latest Tweets after the previous run will be fetched and the file will be+updated. If you have a private stream, you can call the script with a `-p` argument and you will be prompted for a password. The script will then automatically use
hs-twitterarchiver.cabal view
@@ -1,21 +1,27 @@ Name: hs-twitterarchiver-Version: 0.1+Version: 0.2 License: GPL License-file: LICENSE Author: Deepak Jois Maintainer: deepak.jois@gmail.com-homepage: http://github.com/deepakjois/hs-twitterarchiver+Homepage: https://github.com/deepakjois/hs-twitterarchiver+Bug-Reports: https://github.com/deepakjois/hs-twitterarchiver/issues Build-Type: Simple-synopsis: Commandline Twitter feed archiver-description: `hs-twitterarchiver ` is a tool for generating an archive+Synopsis: Commandline Twitter feed archiver+Description: `hs-twitterarchiver ` is a tool for generating an archive of a user's Twitter feed, in a file on a local computer using JSON format. -category: Network-Cabal-Version: >=1.2-data-files: README.md+Category: Network+Cabal-Version: >=1.6+Data-Files: README.md++Source-Repository head+ Type: git+ Location: git://github.com/deepakjois/hs-twitterarchiver.git+ Executable hs-twitterarchiver- hs-source-dirs: .- main-is: hs-twitterarchiver.hs- other-modules: Archiver.Options, Archiver.Twitter, Archiver.Utils - build-depends: base >=3 && < 5, mtl, network, json, HTTP+ Ghc-Options: -Wall+ Hs-Source-Dirs: .+ Main-Is: hs-twitterarchiver.hs+ Build-Depends: base >=3 && < 5, mtl, network, pretty, json, HTTP
hs-twitterarchiver.hs view
@@ -1,11 +1,163 @@-import Archiver.Options-import Archiver.Twitter+-- | Module providing the main hs-twitterarichiver program+--+-- Install the program by running+--+-- @+-- % cabal install hs-twitterarchiver+-- @+--+-- Then run the program with no arguments for help info+-- @+-- % hs-twitterarchiver <username>+-- @+--+module Main (main) where -import Control.Monad.Reader+import Data.Either (rights)+import Data.List (intercalate)+import Control.Applicative ((<$>))+import System.IO.Error (try)+import Network.HTTP (Response(..), simpleHTTP, getRequest, rspBody)+import System.Environment (getProgName, getArgs) -main = do settings <- parseOptions- pastTweets <- runReaderT getPastTweets settings- recentTweets <- runReaderT getRecentTweets (settings { sinceId = calculateSinceId pastTweets})- let allTweets = recentTweets ++ pastTweets- filename = fileName settings- writeTweetsToFile filename allTweets+import Text.JSON (JSON, readJSON, showJSON, makeObj, resultToEither)+import Text.JSON.Types (JSValue(..), JSObject, fromJSObject)+import Text.JSON (Result(..))+import Text.JSON.String (runGetJSON, readJSArray)+import Text.JSON.Pretty (pp_value)++import Text.PrettyPrint (render)++data Tweet = Tweet String -- text+ String -- created at+ Integer -- ID,++tweetId :: Tweet -> Integer+tweetId (Tweet _ _ i) = i++-- Making Tweet typeclass of JSON to enable decode/encode+instance JSON Tweet where+ showJSON (Tweet t c i) =+ makeObj [ ("text", showJSON t)+ , ("created_at", showJSON c)+ , ("id", showJSON i)+ ]++ readJSON (JSObject obj) = do+ i <- lookupM "id"+ t <- lookupM "text"+ c <- lookupM "created_at"+ return $ Tweet t c i+ where+ jsonObjAssoc = fromJSObject obj+ lookupM k = maybe (Error "Property not found") readJSON $ lookup k jsonObjAssoc++ readJSON _ = undefined++-- Get array of Tweets from JSON String+readTweetsFromJSON :: String -> [Tweet]+readTweetsFromJSON tweetsJSON =+ case runGetJSON readJSArray tweetsJSON of+ Right (JSArray xs) -> rights $ map (resultToEither . readJSON) xs+ _ -> []++-- Return the ID of the latest tweet in a list+sinceId :: [Tweet] -> Integer+sinceId [] = 0+sinceId tweets = maximum $ map tweetId tweets++-- Return full URL for user's tweets+twitterUrl :: String -> [(String,String)] -> String+twitterUrl username params+ | params == [] = url+ | otherwise = url ++ queryString+ where+ url = "http://twitter.com/" +++ "statuses/user_timeline/" +++ username ++ ".json"++ queryString = "?" ++ (intercalate "&" $ map (\(k,v) -> k ++ "=" ++ v) params)+++-- Return list of tweets read from a file+readTweetsFromFile :: FilePath -> IO [Tweet]+readTweetsFromFile f = do+ result <- try (readFile f)+ case result of+ Right json -> do+ putStrLn "Reading archive file"+ return $ readTweetsFromJSON json++ Left ex -> do+ putStrLn "Could not read archive file."+ putStrLn (show ex)+ return []++-- Write tweets to a given file+writeTweetsToFile :: FilePath -> [Tweet] -> IO ()+writeTweetsToFile file tweets = writeFile file $ (render . pp_value . showJSON) tweets++-- Fetch all newer tweets and return a list of all tweets+fetchTweets :: String -> [Tweet] -> IO [Tweet]+fetchTweets username oldTweets = fetchTweets' oldTweets 1++ where+ additionalParams+ | sinceId oldTweets == 0 = []+ | otherwise = [("since_id", show $ sinceId oldTweets)]++ fetchTweets' tweetsSoFar page = do+ let params = [("count", "200"), ("page", show page)]+ url = twitterUrl username (params ++ additionalParams)+ putStrLn $ "Fetching tweets from " ++ url+ tweets <- readTweetsFromJSON <$> fetchUrlResponse url+ case tweets of+ [] -> return tweetsSoFar -- Return all tweets found so far+ _ -> fetchTweets' (tweetsSoFar ++ tweets) (page + (1 :: Integer)) -- Fetch next page++fetchUrlResponse :: String -> IO String+fetchUrlResponse url = do+ resp <- simpleHTTP (getRequest url)+ case resp of+ Left err -> error (show err)+ Right result@(Response (2,_,_) _ _ _) -> return $ rspBody result+ Right (Response code _ _ _) -> error $ "Unknown Response " ++ show code++-- Show usage information.+help :: IO ()+help = do+ name <- getProgName+ mapM_ putStrLn+ [ "ABOUT"+ , ""+ , "This is a Twitter stream archiver program."+ , ""+ , "It will try to read a JSON file in the current"+ , "folder and then fetch all newer tweets from Twtter"+ , "and store them in the same file."+ , ""+ , "For example usage, check https://github.com/deepakjois/TwitterArchive"+ , ""+ , "USAGE"+ , ""+ , name ++ " <username> Fetch and store tweets for given handle <username>"+ , ""+ ]++-- Archive tweets of a user+archive :: String -> IO ()+archive username = do+ oldTweets <- readTweetsFromFile $ file+ allTweets <- fetchTweets username oldTweets+ putStrLn "Writing to archive file"+ writeTweetsToFile file allTweets+ where+ file = username ++ ".json"++-- | Main+main :: IO ()+main = do+ args <- getArgs+ case args of+ [username] -> archive username+ _ -> help