tweet-hs 0.5.0.1 → 0.5.1.0
raw patch · 11 files changed
+445/−337 lines, 11 filesdep +compositiondep ~MissingHdep ~ansi-wl-pprintdep ~authenticate-oauth
Dependencies added: composition
Dependency ranges changed: MissingH, ansi-wl-pprint, authenticate-oauth, base, bytestring, data-default, directory, extra, http-client, http-client-tls, http-types, lens, megaparsec, optparse-applicative, split, text, tweet-hs
Files
- README.md +1/−5
- src/Web/Tweet.hs +16/−151
- src/Web/Tweet/API.hs +139/−0
- src/Web/Tweet/Exec.hs +21/−12
- src/Web/Tweet/Parser.hs +97/−0
- src/Web/Tweet/Sign.hs +8/−1
- src/Web/Tweet/Types.hs +4/−5
- src/Web/Tweet/Utils.hs +15/−108
- src/Web/Tweet/Utils/API.hs +71/−0
- src/Web/Tweet/Utils/Colors.hs +4/−0
- tweet-hs.cabal +69/−55
README.md view
@@ -75,7 +75,7 @@ ### Completions -The directory `bash/` has a `mkCompletions` script to allow command completions for your convenice.+The directory `bash/` has a `mkCompletions` script to allow command completions for your convenience. ## Library @@ -92,7 +92,3 @@ ``` will give you a `Tweet` with sensible defaults and the desired text.--### Haskell--This
src/Web/Tweet.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- -- | Various utilities to tweet using the twitter api -- -- Make sure you have a file credentials file (default the executable looks for is `.cred`) with the following info:@@ -20,44 +18,34 @@ ( -- * Functions to tweet basicTweet- , tweetData , thread -- * Data type for a tweet , module Web.Tweet.Types+ -- * Various API calls+ , module Web.Tweet.API -- * Functions to sign API requests , signRequest -- * Functions to generate a URL string from a `Tweet` , urlString- , getTimeline- , showTimeline- , getProfile- , showProfile- , showBest- , getDMs- , showDMs- , getRaw ) where--import Network.HTTP.Client-import Network.HTTP.Client.TLS-import Network.HTTP.Types.Status (statusCode)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.Text as T-import Data.Text.Encoding-import Data.Char+ +import Web.Tweet.Sign+import Web.Tweet.API+import Web.Tweet.Utils.API import Web.Tweet.Types import Web.Tweet.Utils-import Control.Monad import Data.List.Split (chunksOf)-import Data.Maybe+import Control.Monad import Control.Lens-import Control.Lens.Tuple-import Web.Authenticate.OAuth-import Web.Tweet.Sign-import Data.List.Utils-import Text.Megaparsec.Error+import Data.Maybe+import Data.Default +-- | Tweet a string given a path to credentials; return the id of the status.+--+-- > basicTweet "On the airplane." ".cred"+basicTweet :: String -> FilePath -> IO Int+basicTweet contents = tweetData (mkTweet contents)+ -- | thread tweets together nicely. Takes a string, a list of handles to reply to, plus the ID of the status you're replying to. -- If you need to thread tweets without replying, pass a `Nothing` as the third argument. --@@ -76,8 +64,7 @@ -- | Helper function to make `thread` easier to write. thread' :: [String] -> [String] -> Maybe Int -> Int -> FilePath -> IO () thread' content hs idNum num filepath = do- -- fix the stuff with the handles.- let f = \str i -> tweetData (Tweet { _status = str, _trimUser = True, _handles = hs, _replyID = if i == 0 then Nothing else Just i }) filepath+ let f = \str i -> tweetData (Tweet { _status = str, _handles = hs, _replyID = if i == 0 then Nothing else Just i }) filepath let initial = f (head content) last <- foldr ((>=>) . f) initial (content) $ fromMaybe 0 idNum deleteTweet last filepath@@ -88,128 +75,6 @@ reply :: String -> [String] -> Maybe Int -> FilePath -> IO () reply contents hs idNum = thread contents hs idNum 1 --- | Tweet a string given a path to credentials; return the id of the status.------ > basicTweet "On the airplane." ".cred"-basicTweet :: String -> FilePath -> IO Int-basicTweet contents = tweetData (mkTweet contents)- -- | Make a `Tweet` with only the contents. mkTweet :: String -> Tweet mkTweet contents = over (status) (const (contents)) def ---- | tweet, given a `Tweet` and path to credentials. Return id of posted tweet.-tweetData :: Tweet -> FilePath -> IO Int-tweetData tweet filepath = do- let requestString = urlString tweet- manager <- newManager tlsManagerSettings- initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/update.json" ++ requestString)- request <- signRequest filepath $ initialRequest { method = "POST" }- responseInt request manager---- | Get tweets (text only) for some user--- TODO make it recursive/have it read max_id from returned tweet.-getRaw :: String -> Maybe Int -> FilePath -> IO [String]-getRaw screenName maxId filepath = do- tweets <- either (error "Parse tweets failed") id <$> getProfileMax screenName 200 filepath maxId- let lastId = _tweetId . last $ tweets- if (Just lastId) == maxId then - pure []- else- do- putStrLn $ "fetching tweets since " ++ show lastId ++ "..."- next <- getRaw screenName (Just lastId) filepath- pure ((map _text tweets) ++ next)--getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline)-getProfileMax screenName count filepath maxId = do- let requestString = case maxId of {- (Just id) -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show id) ;- Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) }- manager <- newManager tlsManagerSettings- initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString)- request <- signRequest filepath $ initialRequest { method = "GET"}- responseBS request manager -- TODO- getTweets . BSL.unpack <$> responseBS request manager---- | Get user profile given screen name and how many tweets to return-getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)-getProfile screenName count filepath = getProfileMax screenName count filepath Nothing---- | Show your DMs, given how many to return and whether or not to use color.-showDMs count color filepath = showTweets color <$> getDMs count filepath---- | Show a user profile given screen name, how many tweets to return (API--- maximum is 3200), and whether to print them in color.-showProfile :: String -> Int -> Bool -> FilePath -> IO String-showProfile screenName count color filepath = showTweets color <$> getProfile screenName count filepath---- | Show the most successful tweets by a given user, given their screen name. -showBest :: String -> Bool -> FilePath -> IO String-showBest screenName color filepath = showTweets color . (fmap (take 13 . hits)) <$> getProfile screenName 3200 filepath---- | Display user timeline-showTimeline :: Int -> Bool -> FilePath -> IO String-showTimeline count color filepath = showTweets color <$> getTimeline count filepath---- | Display user timeline in color-showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String-showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline))---- | Get user's DMs.-getDMs count filepath = do- let requestString = "?count=" ++ (show count)- manager <- newManager tlsManagerSettings- initialRequest <- parseRequest ("https://api.twitter.com/1.1/direct_messages.json" ++ requestString)- request <- signRequest filepath $ initialRequest { method = "GET" }- getTweets . BSL.unpack <$> responseBS request manager---- | Get a timeline-getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)-getTimeline count filepath = do- let requestString = "?count=" ++ (show count)- manager <- newManager tlsManagerSettings- initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/home_timeline.json" ++ requestString)- request <- signRequest filepath $ initialRequest { method = "GET" }- getTweets . BSL.unpack <$> responseBS request manager---- | Delete a tweet given its id-deleteTweet id filepath = do- manager <- newManager tlsManagerSettings- initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show id) ++ ".json")- request <- signRequest filepath $ initialRequest { method = "POST" }- void $ responseBS request manager---- | Return HTTP request's result as a bytestring-responseBS :: Request -> Manager -> IO BSL.ByteString-responseBS request manager = do- response <- httpLbs request manager- let code = statusCode $ responseStatus response- putStr $ if (code == 200) then "" else "failed :(\n error code: " ++ (show code) ++ "\n"- pure . responseBody $ response---- | print output of a request and return status id as an `Int`. -responseInt :: Request -> Manager -> IO Int-responseInt request manager = do- response <- httpLbs request manager- let code = statusCode $ responseStatus response- putStrLn $ if (code == 200) then "POST succesful!" else "failed :(\n error code: " ++ (show code)- return $ (read . (takeWhile (/=',')) . (drop 52)) (BSL.unpack $ responseBody response)---- | Convert a tweet to a percent-encoded url for querying an API-urlString :: Tweet -> String-urlString tweet = concat [ "?status="- , BS.unpack (tweetEncode tweet)- , "&trim_user="- , map toLower (show trim)- , (if isJust (_replyID tweet) then "&in_reply_to_status_id=" else "")- , reply ]- where trim = _trimUser tweet- reply = fromMaybe "" (show <$> _replyID tweet)---- | Percent-encode the status update so it's fit for a URL and UTF-encode it as well. -tweetEncode :: Tweet -> BS.ByteString-tweetEncode tweet = paramEncode . encodeUtf8 $ handleStr `T.append` content- where content = T.pack . _status $ tweet- handleStr = T.pack $ concatMap ((++ " ") . ((++) "@")) hs- hs = _handles tweet
+ src/Web/Tweet/API.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Module containing the functions directly dealing with twitter's API+module Web.Tweet.API where++import Network.HTTP.Client+import Network.HTTP.Client.TLS+import qualified Data.ByteString.Lazy.Char8 as BSL+import Data.Text.Encoding+import Web.Tweet.Types+import Web.Tweet.Utils+import Control.Monad+import Control.Lens+import Web.Tweet.Sign+import Text.Megaparsec.Error+import Web.Tweet.Utils.API+import Data.Composition++-- | Get tweets (text only) for some user+getMarkov :: String -> Maybe Int -> FilePath -> IO [String]+getMarkov = (fmap (map (view text))) .** getAll ++-- | Get all tweets by some user+getAll :: String -> Maybe Int -> FilePath -> IO Timeline+getAll screenName maxId filepath = do+ tweets <- either (error "Parse tweets failed") id <$> getProfileMax screenName 200 filepath maxId+ let lastId = _tweetId . last $ tweets+ if (Just lastId) == maxId then + pure []+ else+ do+ putStrLn $ "fetching tweets since " ++ show lastId ++ "..."+ next <- getAll screenName (Just lastId) filepath+ pure (tweets ++ next)++-- | tweet, given a `Tweet` and path to credentials. Return id of posted tweet.+tweetData :: Tweet -> FilePath -> IO Int+tweetData tweet filepath = do+ let requestString = urlString tweet+ bytes <- postRequest ("https://api.twitter.com/1.1/statuses/update.json" ++ requestString) filepath+ pure . (view tweetId) . head . either (error "failed to parse tweet") id . getTweets . BSL.unpack $ bytes++-- | Gets user profile with max_id set.+getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline)+getProfileMax screenName count filepath maxId = getTweets . BSL.unpack <$> getProfileRaw screenName count filepath maxId++-- | Gets user profile with max_id set.+getProfileRaw :: String -> Int -> FilePath -> Maybe Int -> IO BSL.ByteString+getProfileRaw screenName count filepath maxId = getRequest ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString) filepath+ where requestString = case maxId of {+ (Just id) -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show id) ;+ Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) }++-- | Get user profile given screen name and how many tweets to return+getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+getProfile screenName count filepath = getProfileMax screenName count filepath Nothing++-- | Show a user profile given screen name, how many tweets to return, +-- and whether to print them in color.+showProfile :: String -> Int -> Bool -> FilePath -> IO String+showProfile screenName count color filepath = showTweets color <$> getProfile screenName count filepath++-- | Show the most successful tweets by a given user, given their screen name. +showBest :: String -> Bool -> FilePath -> IO String+showBest screenName color filepath = showTweets color . pure . (take 13 . hits) <$> getAll screenName Nothing filepath +-- (fmap (take 13 . hits)) <$> getProfile screenName 3200 filepath++-- | Display user timeline+showTimeline :: Int -> Bool -> FilePath -> IO String+showTimeline count color = (fmap (showTweets color)) . getTimeline count ++-- | Display user timeline in color, as appropriate+showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String+showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline))++-- | Get user's DMs.+getDMsRaw count = getRequest ("https://api.twitter.com/1.1/direct_messages.json" ++ requestString)+ where requestString = "?count=" ++ (show count)++-- | Get a timeline+getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+getTimeline = (fmap (getTweets . BSL.unpack)) .* getTimelineRaw++-- | Get a user's timeline and return response as a bytestring+getTimelineRaw :: Int -> FilePath -> IO BSL.ByteString+getTimelineRaw count = getRequest ("https://api.twitter.com/1.1/statuses/home_timeline.json" ++ requestString)+ where requestString = "?count=" ++ (show count)++-- | Delete a tweet given its id+deleteTweet :: Int -> FilePath -> IO ()+deleteTweet = (fmap void) . deleteTweetRaw++-- | Favorite a tweet given its id+favoriteTweet :: Int -> FilePath -> IO ()+favoriteTweet = (fmap void) . favoriteTweetRaw++-- | Unfavorite a tweet given its id+unfavoriteTweet :: Int -> FilePath -> IO ()+unfavoriteTweet = (fmap void) . unfavoriteTweetRaw++-- | Unretweet a tweet given its id+unretweetTweet :: Int -> FilePath -> IO ()+unretweetTweet = (fmap void) . unretweetTweetRaw++-- | Retweet a tweet given its id+retweetTweet :: Int -> FilePath -> IO ()+retweetTweet = (fmap void) . retweetTweetRaw++-- | Favorite a tweet given its id; return bytestring response+favoriteTweetRaw :: Int -> FilePath -> IO BSL.ByteString+favoriteTweetRaw id = postRequest ("https://api.twitter.com/1.1/favorites/destroy/" ++ (show id) ++ ".json")++-- | Retweet a tweet given its id; return bytestring response+retweetTweetRaw :: Int -> FilePath -> IO BSL.ByteString+retweetTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/retweet/" ++ (show id) ++ ".json")++-- | Send a DM given text, screen name of recipient.+sendDMRaw txt screenName = postRequest ("https://api.twitter.com/1.1/direct_messages/new.json?text=" ++ encoded ++ "&screen_name" ++ screenName ++ ".json")+ where encoded = strEncode $ txt++-- | Follow a user given their screen name+followUser :: String -> FilePath -> IO BSL.ByteString+followUser screenName = postRequest("https://api.twitter.com/1.1/friendships/create.json?screen_name=" ++ screenName)++-- | Follow a user given their screen name+unfollowUser :: String -> FilePath -> IO BSL.ByteString+unfollowUser screenName = postRequest("https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" ++ screenName)++-- | Unretweet a tweet given its id; return bytestring response+unretweetTweetRaw :: Int -> FilePath -> IO BSL.ByteString+unretweetTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/unretweet/" ++ (show id) ++ ".json")++-- | Favorite a tweet given its id; return bytestring response+unfavoriteTweetRaw :: Int -> FilePath -> IO BSL.ByteString+unfavoriteTweetRaw id = postRequest ("https://api.twitter.com/1.1/favorites/destroy/" ++ (show id) ++ ".json")++-- | Delete a tweet given its id; return bytestring response+deleteTweetRaw :: Int -> FilePath -> IO BSL.ByteString+deleteTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show id) ++ ".json")
src/Web/Tweet/Exec.hs view
@@ -8,8 +8,8 @@ import qualified Data.ByteString.Char8 as BS import Control.Monad import Data.Foldable (fold)-import Data.List-import Data.Monoid+import Data.List hiding (delete)+import Data.Monoid hiding (getAll) import System.Directory -- | Data type for our program: one optional path to a credential file, (optionally) the number of tweetInputs to make, the id of the status you're replying to, and a list of users you wish to mention.@@ -19,9 +19,10 @@ data Command = Timeline { count :: Maybe Int , color :: Bool } | SendInput { tweetInputs :: Maybe Int, replyId :: Maybe String, replyHandles :: Maybe [String] } | Profile { count :: Maybe Int , color :: Bool , screenName :: String }- | Raw { screenName :: String }+ | Markov { screenName :: String } | Send { tweets :: Maybe Int , replyId :: Maybe String , replyHandles :: Maybe [String] , userInput :: String } | Sort { color :: Bool , screenName :: String }+ | Delete { twId :: Integer } -- | query twitter to post stdin with no fancy options fromStdIn :: Int -> FilePath -> IO ()@@ -92,12 +93,12 @@ select (Program (Sort True name) Nothing) = putStrLn =<< showBest name True =<< (++ "/.cred") <$> getHomeDirectory select (Program (Sort False name) (Just file)) = putStrLn =<< showBest name False file select (Program (Sort False name) Nothing) = putStrLn =<< showBest name False =<< (++ "/.cred") <$> getHomeDirectory-select (Program (Raw name) Nothing) = do- raw <- getRaw name Nothing =<< (++ "/.cred") <$> getHomeDirectory+select (Program (Markov name) Nothing) = do+ raw <- getMarkov name Nothing =<< (++ "/.cred") <$> getHomeDirectory writeFile (name ++ ".txt") (unlines raw) putStrLn $ "Written output to: " ++ name ++ ".txt"-select (Program (Raw name) (Just file)) = do- raw <- getRaw name Nothing file+select (Program (Markov name) (Just file)) = do+ raw <- getMarkov name Nothing file writeFile (name ++ ".txt") (unlines raw) putStrLn $ "Written output to: " ++ name ++ ".txt" @@ -109,8 +110,9 @@ <> command "input" (info tweetInput (progDesc "Send a tweet from stdIn")) <> command "view" (info timeline (progDesc "Get your timeline")) <> command "user" (info profile (progDesc "Get a user's profile"))- <> command "raw" (info raw (progDesc "Grab tweets en masse."))- <> command "hits" (info best (progDesc "View a user's top tweets."))))+ <> command "markov" (info markov (progDesc "Grab tweets en masse."))+ <> command "hits" (info best (progDesc "View a user's top tweets."))+ <> command "del" (info delete (progDesc "View a user's top tweets.")))) <*> (optional $ strOption (long "cred" <> short 'c'@@ -131,11 +133,18 @@ <> help "Display timeline with colorized terminal output.") -- | Parser for the raw subcommand-raw :: Parser Command-raw = Raw+markov :: Parser Command+markov = Markov <$> argument str (metavar "SCREEN_NAME"- <> help "Screen name of user whose tweetInputs you want in bulk.")+ <> help "Screen name of user whose tweets you want in bulk.")++-- | Parser for the raw subcommand+delete :: Parser Command+delete = Delete+ <$> read <$> (argument str+ (metavar "TWEET_ID"+ <> help "ID of tweet to delete")) -- | Parser for the user subcommand profile :: Parser Command
+ src/Web/Tweet/Parser.hs view
@@ -0,0 +1,97 @@+-- FIXME make this module available under cabal file+-- | Module containing parsers for tweet and response data.+module Web.Tweet.Parser where++import Text.Megaparsec.String+import Text.Megaparsec.Lexer as L+import Text.Megaparsec+import Web.Tweet.Types+import Data.Monoid+import Data.Maybe+import Control.Monad++-- | Parse some number of tweets+parseTweet :: Parser Timeline+parseTweet = many (try getData <|> (const (TweetEntity "" "" "" 0 Nothing 0 0) <$> eof))++-- | Parse a single tweet's: name, text, fave count, retweet count+getData :: Parser TweetEntity+getData = do+ id <- read <$> filterStr "id" + text <- filterStr "text"+ skipMentions+ name <- filterStr "name"+ screenName <- filterStr "screen_name"+ isQuote <- filterStr "is_quote_status"+ case isQuote of+ "false" -> do+ rts <- read <$> filterStr "retweet_count"+ faves <- read <$> filterStr "favorite_count"+ pure (TweetEntity text name screenName id Nothing rts faves)+ "true" -> do+ idQuoted <- read <$> filterStr "id"+ textQuoted <- filterStr "text"+ skipMentions+ nameQuoted <- filterStr "name"+ screenNameQuoted <- filterStr "screen_name"+ rtsQuoted <- read <$> filterStr "retweet_count"+ favesQuoted <- read <$> filterStr "favorite_count"+ rts <- read <$> filterStr "retweet_count"+ faves <- read <$> filterStr "favorite_count"+ pure $ TweetEntity text name screenName id (Just (TweetEntity textQuoted nameQuoted screenNameQuoted idQuoted Nothing rtsQuoted favesQuoted)) rts faves++-- | Skip a set of square brackets []+skipInsideBrackets :: Parser ()+skipInsideBrackets = void (between (char '[') (char ']') $ many (skipInsideBrackets <|> void (noneOf "[]")))++-- | Skip user mentions field to avoid parsing the wrong name+skipMentions :: Parser ()+skipMentions = do+ many $ try $ anyChar >> notFollowedBy (string ("\"user_mentions\":"))+ char ','+ string "\"user_mentions\":"+ skipInsideBrackets+ pure ()++-- | Throw out input until we get to a relevant tag.+filterStr :: String -> Parser String+filterStr str = do+ many $ try $ anyChar >> notFollowedBy (string ("\"" <> str <> "\":"))+ char ','+ filterTag str++-- | Parse a field given its tag+filterTag :: String -> Parser String+filterTag str = do+ string $ "\"" <> str <> "\":"+ open <- optional $ char '\"'+ let forbidden = if (isJust open) then "\\\"" else "\\\","+ want <- many $ noneOf forbidden <|> specialChar '\"' <|> specialChar '/' <|> newlineChar <|> unicodeChar -- specialChar 'u'+ pure want++-- | Parse a newline+newlineChar :: Parser Char+newlineChar = do+ string "\\n"+ pure '\n'++-- | Parser for unicode; twitter will give us something like "/u320a"+unicodeChar :: Parser Char+unicodeChar = do+ string "\\u"+ num <- fromHex . filterEmoji <$> count 4 anyChar+ pure . toEnum . fromIntegral $ num++-- | helper function to ignore emoji+filterEmoji str = if head str == 'd' then "FFFD" else str++-- | Parse escaped characters+specialChar :: Char -> Parser Char+specialChar c = do+ string $ "\\" ++ pure c+ pure c++-- | Convert a string of four hexadecimal digits to an integer.+fromHex :: String -> Integer+fromHex = fromRight . (parse (L.hexadecimal :: Parser Integer) "")+ where fromRight (Right a) = a
src/Web/Tweet/Sign.hs view
@@ -6,6 +6,7 @@ import Web.Tweet.Utils import Web.Authenticate.OAuth import Network.HTTP.Client+import Web.Tweet.Types -- | Sign a request using your OAuth dev token. -- Uses the IO monad because signatures require a timestamp@@ -15,7 +16,13 @@ c <- credential filepath signOAuth o c req --- | Create an OAuth from config data in a file+-- TODO function to read a ~/.tweetrc file to a 'Config'++-- | Sign a request using a 'Config' object, avoiding the need to read token/key from file+signRequestMem :: Config -> Request -> IO Request+signRequestMem = uncurry signOAuth++-- | Create an OAuth api key from config data in a file oAuth :: FilePath -> IO OAuth oAuth filepath = do secret <- (lineByKey "api-sec") <$> getConfigData filepath
src/Web/Tweet/Types.hs view
@@ -8,15 +8,11 @@ import GHC.Generics import Control.Lens import Data.Default---- | Default value for Bool for trim_user (`True` in our case)-instance Default Bool where- def = True+import Web.Authenticate.OAuth -- | Data type for our request: consists of the status text, whether to trium user information in the response, the handles to mention, and optionally the id of the status to reply to. data Tweet = Tweet { _status :: String- , _trimUser :: Bool , _handles :: [String] , _replyID :: Maybe Int } deriving (Generic, Default)@@ -34,6 +30,9 @@ -- | Stores data like (name, text, favoriteCount, retweetCount) type Timeline = [TweetEntity]++-- | Contains an 'OAuth' and a 'Credential'; encapsulates everything needed to sign a request.+type Config = (OAuth, Credential) makeLenses ''Tweet
src/Web/Tweet/Utils.hs view
@@ -2,25 +2,30 @@ module Web.Tweet.Utils where import qualified Data.ByteString.Char8 as BS-import Text.Megaparsec.String-import Text.Megaparsec.Lexer as L-import Text.Megaparsec import Data.Char import Data.List import Data.Monoid-import Data.Maybe import Web.Tweet.Types-import Control.Monad import Control.Lens.Tuple import Control.Lens hiding (noneOf) import Data.Function import Web.Tweet.Utils.Colors import Data.List.Extra+import Web.Tweet.Parser+import Text.Megaparsec --- `FIXME` -parseDMs = zip <$> (extractEvery 2 <$> filterStr "screen_name") <*> (filterStr "text")- where extractEvery n = map snd . filter ((== n) . fst) . zip (cycle [1..n])+-- | filter out retweets, and sort by most successful.+hits :: Timeline -> Timeline+hits = sortTweets . filterRTs +-- | Filter out retweets+filterRTs :: Timeline -> Timeline+filterRTs = filter ((/="RT @") . take 4 . (view text))++-- | Get a list of tweets from a response, returning author, favorites, retweets, and content. +getTweets :: String -> Either (ParseError Char Dec) Timeline+getTweets = parse parseTweet "" + -- | Display Timeline without color displayTimeline :: Timeline -> String displayTimeline ((TweetEntity content user _ _ Nothing fave rts):rest) = (user <> ":\n " <> (fixNewline content)) <> "\n " <> "♥ " <> (show fave) <> " ♺ " <> (show rts) <> "\n\n" <> (displayTimeline rest) @@ -33,112 +38,14 @@ displayTimelineColor ((TweetEntity content user _ _ (Just quoted) fave rts):rest) = ((toYellow user) <> ":\n " <> (fixNewline content)) <> "\n " <> (toRed "♥ ") <> (show fave) <> (toGreen " ♺ ") <> (show rts) <> "\n " <> (toYellow $ _name quoted) <> ": " <> (_text quoted) <> "\n\n" <> (displayTimelineColor rest) displayTimelineColor [] = [] +-- | When displaying, newlines should include indentation. fixNewline :: String -> String fixNewline = replace "\n" "\n " --- | Get a list of tweets from a response, returning author, favorites, retweets, and content. -getTweets = parse parseTweet "" ---- TODO add feature to filter out quotes etc. Or make it a sub-thing?+-- | sort tweets by most successful sortTweets :: Timeline -> Timeline sortTweets = sortBy compareTweet where compareTweet (TweetEntity _ _ _ _ _ f1 r1) (TweetEntity _ _ _ _ _ f2 r2) = compare (2*r2 + f2) (2*r1 + f1)---- | Parse some number of tweets-parseTweet :: Parser Timeline-parseTweet = many (try getData <|> (const (TweetEntity "" "" "" 0 Nothing 0 0) <$> eof))--hits = sortTweets . filterRTs--filterRTs :: Timeline -> Timeline-filterRTs = filter ((/="RT @") . take 4 . (view text))---- | Parse a single tweet's: name, text, fave count, retweet count-getData :: Parser TweetEntity-getData = do- id <- read <$> filterStr "id" -- FIXME check it doesn't drop anything- text <- filterStr "text"- skipMentions- name <- filterStr "name"- screenName <- filterStr "screen_name"- isQuote <- filterStr "is_quote_status"- case isQuote of- "false" -> do- rts <- read <$> filterStr "retweet_count"- faves <- read <$> filterStr "favorite_count"- pure (TweetEntity text name screenName id Nothing rts faves)- "true" -> do- idQuoted <- read <$> filterStr "id"- textQuoted <- filterStr "text"- skipMentions- nameQuoted <- filterStr "name"- screenNameQuoted <- filterStr "screen_name"- rtsQuoted <- read <$> filterStr "retweet_count"- favesQuoted <- read <$> filterStr "favorite_count"- rts <- read <$> filterStr "retweet_count"- faves <- read <$> filterStr "favorite_count"- pure $ TweetEntity text name screenName id (Just (TweetEntity textQuoted nameQuoted screenNameQuoted idQuoted Nothing rtsQuoted favesQuoted)) rts faves---- TODO make it work when user names include ]-skipInsideBrackets :: Parser ()-skipInsideBrackets = void (between (char '[') (char ']') $ many (skipInsideBrackets <|> void (noneOf "[]")))--skipMentions :: Parser ()-skipMentions = do- many $ try $ anyChar >> notFollowedBy (string ("\"user_mentions\":"))- char ','- string "\"user_mentions\":"- skipInsideBrackets --between (char '[') (char ']') (many $ anyChar)- pure ()---- | Throw out input until we get to a relevant tag.-filterStr :: String -> Parser String-filterStr str = do- many $ try $ anyChar >> notFollowedBy (string ("\"" <> str <> "\":"))- char ','- filterTag str---- | Parse a field given its tag-filterTag :: String -> Parser String-filterTag str = do- string $ "\"" <> str <> "\":"- open <- optional $ char '\"'- let forbidden = if (isJust open) then "\\\"" else "\\\","- want <- many $ noneOf forbidden <|> specialChar '\"' <|> specialChar '/' <|> newlineChar <|> unicodeChar -- specialChar 'u'- pure want---- | Parse a newline-newlineChar :: Parser Char-newlineChar = do- string "\\n"- pure '\n'---- TODO---emoji :: Parser Char---emoji = do--- string "\\u"- --d83d dc8c 💌---- | Parser for unicode; twitter will give us something like "/u320a"-unicodeChar :: Parser Char-unicodeChar = do- string "\\u"- num <- fromHex . filterEmoji <$> count 4 anyChar- pure . toEnum . fromIntegral $ num---- | ignore emoji -filterEmoji str = if head str == 'd' then "FFFD" else str---- | Parse escaped characters-specialChar :: Char -> Parser Char-specialChar c = do- string $ "\\" ++ pure c- pure c---- | Convert a string of four hexadecimal digits to an integer.-fromHex :: String -> Integer-fromHex = fromRight . (parse (L.hexadecimal :: Parser Integer) "")- where fromRight (Right a) = a -- | helper function to get the key as read from a file keyLinePie :: String -> String
+ src/Web/Tweet/Utils/API.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Utils for working with the API+module Web.Tweet.Utils.API where++import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types.Status (statusCode)+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text as T+import Web.Tweet.Types+import Data.Char+import Data.Maybe+import Web.Authenticate.OAuth+import Data.Text.Encoding+import Web.Tweet.Sign++-- | Make a GET request to twitter given a request string+getRequest :: String -> FilePath -> IO BSL.ByteString+getRequest urlStr filepath = do+ manager <- newManager tlsManagerSettings+ initialRequest <- parseRequest urlStr+ request <- signRequest filepath $ initialRequest { method = "GET" }+ responseBS request manager++-- | Make a POST request to twitter given a request string+postRequest :: String -> FilePath -> IO BSL.ByteString+postRequest urlStr filepath = do+ manager <- newManager tlsManagerSettings+ initialRequest <- parseRequest urlStr+ request <- signRequest filepath $ initialRequest { method = "POST" }+ responseBS request manager++-- | Return HTTP request's result as a bytestring+responseBS :: Request -> Manager -> IO BSL.ByteString+responseBS request manager = do+ response <- httpLbs request manager+ let code = statusCode $ responseStatus response+ putStr $ if (code == 200) then "" else "failed :(\n error code: " ++ (show code) ++ "\n"+ pure . responseBody $ response++-- | print output of a request and return status id as an `Int`. +responseInt :: Request -> Manager -> IO Int+responseInt request manager = do+ response <- httpLbs request manager+ let code = statusCode $ responseStatus response+ putStrLn $ if (code == 200) then "POST succesful!" else "failed :(\n error code: " ++ (show code)+ return $ (read . (takeWhile (/=',')) . (drop 52)) (BSL.unpack $ responseBody response) -- TODO use the more general parser++-- | Convert a tweet to a percent-encoded url for querying an API+urlString :: Tweet -> String+urlString tweet = concat [ "?status="+ , BS.unpack (tweetEncode tweet)+ , "&trim_user="+ , map toLower (show trim)+ , (if isJust (_replyID tweet) then "&in_reply_to_status_id=" else "")+ , reply ]+ where trim = False+ reply = fromMaybe "" (show <$> _replyID tweet)++-- | Percent-encode a string+strEncode :: String -> String+strEncode = BS.unpack . paramEncode . encodeUtf8 . T.pack++-- | Percent-encode the status update so it's fit for a URL and UTF-encode it as well. +tweetEncode :: Tweet -> BS.ByteString+tweetEncode tweet = paramEncode . encodeUtf8 $ handleStr `T.append` content+ where content = T.pack . _status $ tweet+ handleStr = T.pack $ concatMap ((++ " ") . ((++) "@")) hs+ hs = _handles tweet
src/Web/Tweet/Utils/Colors.hs view
@@ -1,12 +1,16 @@+-- | Helper functions to color strings module Web.Tweet.Utils.Colors where import Text.PrettyPrint.ANSI.Leijen +-- | Make a string red toRed :: String -> String toRed = show . red . text +-- | Make a string yellow toYellow :: String -> String toYellow = show . dullyellow . text +-- | Make a string green toGreen :: String -> String toGreen = show . dullgreen . text
tweet-hs.cabal view
@@ -1,61 +1,75 @@-name: tweet-hs-version: 0.5.0.1-synopsis: Post tweets from stdin-description: a Command Line Interface Tweeter-homepage: https://github.com/vmchale/command-line-tweeter#readme-license: BSD3-license-file: LICENSE-author: Vanessa McHale-maintainer: tmchale@wisc.edu-copyright: 2016 Vanessa McHale-category: Web-build-type: Simple-stability: stable-extra-source-files: README.md, stack.yaml, bash/mkCompletions-cabal-version: >=1.10+name: tweet-hs+version: 0.5.1.0+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: 2016 Vanessa McHale+maintainer: tmchale@wisc.edu+stability: stable+homepage: https://github.com/vmchale/command-line-tweeter#readme+synopsis: Command-line tool for twitter+description:+ a Command Line Interface Tweeter+category: Web+author: Vanessa McHale+extra-source-files:+ README.md+ stack.yaml+ bash/mkCompletions -Flag llvm-fast {- Description: Enable build with llvm backend- Default: False-}+source-repository head+ type: git+ location: https://github.com/vmchale/command-line-tweeter +flag llvm-fast+ description:+ Enable build with llvm backend+ default: False+ library- hs-source-dirs: src- exposed-modules: Web.Tweet- , Web.Tweet.Exec- other-modules: Web.Tweet.Types- , Web.Tweet.Utils- , Web.Tweet.Utils.Colors- , Web.Tweet.Sign- build-depends: base >= 4.7 && < 5- , http-client-tls- , http-client- , http-types- , authenticate-oauth- , bytestring- , split- , optparse-applicative - , lens- , data-default- , text- , megaparsec- , ansi-wl-pprint- , MissingH- , directory- , extra- default-language: Haskell2010+ exposed-modules:+ Web.Tweet+ Web.Tweet.Exec+ build-depends:+ base >=4.7 && <5,+ http-client-tls >=0.3.4 && <0.4,+ http-client >=0.5.6.1 && <0.6,+ http-types >=0.9.1 && <0.10,+ authenticate-oauth ==1.6.*,+ bytestring >=0.10.8.1 && <0.11,+ split >=0.2.3.1 && <0.3,+ optparse-applicative >=0.13.2.0 && <0.14,+ lens >=4.15.1 && <4.16,+ data-default >=0.7.1.1 && <0.8,+ text >=1.2.2.1 && <1.3,+ megaparsec >=5.2.0 && <5.3,+ ansi-wl-pprint >=0.6.7.3 && <0.7,+ MissingH >=1.4.0.1 && <1.5,+ directory >=1.3.0.0 && <1.4,+ extra >=1.5.1 && <1.6,+ composition >=1.0.2.1 && <1.1+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules:+ Web.Tweet.Types+ Web.Tweet.Utils+ Web.Tweet.Utils.Colors+ Web.Tweet.Sign+ Web.Tweet.Parser+ Web.Tweet.API+ Web.Tweet.Utils.API executable tweet- hs-source-dirs: app- main-is: Main.hs- if flag(llvm-fast)- ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3- else- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends: base- , tweet-hs - default-language: Haskell2010+ + if flag(llvm-fast)+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3+ else+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ main-is: Main.hs+ build-depends:+ base >=4.9.1.0 && <4.10,+ tweet-hs >=0.5.1.0 && <0.6+ default-language: Haskell2010+ hs-source-dirs: app -source-repository head- type: git- location: https://github.com/vmchale/command-line-tweeter