diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -6,11 +6,13 @@ import Web.Tweet.Parser import Web.Tweet.Parser.FastParser +setupEnv :: IO BS.ByteString setupEnv = BS.readFile "test/data" -setupEnv' = readFile "test/data" -fast = fmap (fmap fromFast) . fastParse +setupEnv' :: IO String +setupEnv' = readFile "test/data" +main :: IO () main = do defaultMain [ env setupEnv $ \ ~file -> @@ -20,3 +22,6 @@ bgroup "handrolled parser" [ bench "226" $ whnf (parse parseTweet) file ] ] + where + fast = fmap (fmap fromFast) . fastParse + diff --git a/src/Web/Tweet.hs b/src/Web/Tweet.hs --- a/src/Web/Tweet.hs +++ b/src/Web/Tweet.hs @@ -1,5 +1,5 @@ -- | 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: -- -- @ @@ -19,6 +19,7 @@ -- * Functions to tweet basicTweet , thread + , reply -- * Data type for a tweet , module Web.Tweet.Types -- * Various API calls @@ -31,19 +32,19 @@ -- * Helper function to print a bird , bird ) where - -import Web.Tweet.Sign -import Web.Tweet.API -import Web.Tweet.API.Internal -import Web.Tweet.Utils.API -import Web.Tweet.Utils -import Web.Tweet.Types -import Data.List.Split (chunksOf) -import Control.Monad -import Control.Lens -import Data.Maybe -import Data.Default +import Control.Lens +import Control.Monad +import Data.Default +import Data.List.Split (chunksOf) +import Data.Maybe +import Web.Tweet.API +import Web.Tweet.API.Internal +import Web.Tweet.Sign +import Web.Tweet.Types +import Web.Tweet.Utils +import Web.Tweet.Utils.API + -- | Tweet a string given a path to credentials; return the id of the status. -- -- > basicTweet "On the airplane." ".cred" @@ -59,19 +60,19 @@ let handleStr = concatMap (((++) " ") . ((++) "@")) hs let content = (take num) . (chunksOf (140-(length handleStr))) $ contents case idNum of - (Just i) -> thread' content hs idNum num filepath + (Just _) -> thread' content hs idNum filepath Nothing -> case content of - [] -> pure () - [x] -> void $ basicTweet x filepath - y@(x:xs) -> thread' y hs (Just 0) num filepath + [] -> pure () + [x] -> void $ basicTweet x filepath + y@(_:_) -> thread' y hs (Just 0) filepath --- | Helper function to make `thread` easier to write. -thread' :: [String] -> [String] -> Maybe Int -> Int -> FilePath -> IO () -thread' content hs idNum num filepath = do +-- | Helper function to make `thread` easier to write. +thread' :: [String] -> [String] -> Maybe Int -> FilePath -> IO () +thread' content hs idNum filepath = do 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 (fromIntegral last) filepath + lastTweet <- foldr ((>=>) . f) initial (content) $ fromMaybe 0 idNum + deleteTweet (fromIntegral lastTweet) filepath -- | Reply with a single tweet. Works the same as `thread` but doesn't take the fourth argument. -- @@ -81,4 +82,4 @@ -- | Make a `Tweet` with only the contents. mkTweet :: String -> Tweet -mkTweet contents = over (status) (const (contents)) def +mkTweet contents = over (status) (const (contents)) def diff --git a/src/Web/Tweet/API.hs b/src/Web/Tweet/API.hs --- a/src/Web/Tweet/API.hs +++ b/src/Web/Tweet/API.hs @@ -19,15 +19,15 @@ -- | 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 +getAll sn maxId filepath = do + tweets <- either (error "Parse tweets failed") id <$> getProfileMax sn 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 + next <- getAll sn (Just lastId) filepath pure (tweets ++ next) -- | tweet, given a `Tweet` and a `Config` containing necessary data to sign the request. @@ -56,17 +56,17 @@ -- | 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 +getProfileRaw sn 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) } + (Just i) -> "?screen_name=" ++ sn ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show i) ; + Nothing -> "?screen_name=" ++ sn ++ "&count=" ++ (show count) } -- | Gets user profile with max_id set getProfileRawMem :: String -> Int -> Config -> Maybe Int -> IO BSL.ByteString -getProfileRawMem screenName count config maxId = getRequestMem ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString) config +getProfileRawMem sn count config maxId = getRequestMem ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString) config where requestString = case maxId of { - (Just id) -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show id) ; - Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) } + (Just i) -> "?screen_name=" ++ sn ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show i) ; + Nothing -> "?screen_name=" ++ sn ++ "&count=" ++ (show count) } -- | Get mentions and parse response as a list of tweets mentions :: Int -> FilePath -> IO (Either (ParseError Char Void) Timeline) @@ -88,7 +88,7 @@ -- | Get user profile given screen name and how many tweets to return getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Void) Timeline) -getProfile screenName count filepath = getProfileMax screenName count filepath Nothing +getProfile sn count filepath = getProfileMax sn count filepath Nothing -- | Mute a user given their screen name mute :: String -> FilePath -> IO () @@ -108,21 +108,22 @@ -- | Mute a user given their screen name muteUserRaw :: String -> FilePath -> IO BSL.ByteString -muteUserRaw screenName = postRequest ("https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" ++ screenName) +muteUserRaw sn = postRequest ("https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" ++ sn) -- | Mute a user given their screen name muteUserRawMem :: String -> Config -> IO BSL.ByteString -muteUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" ++ screenName) +muteUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" ++ sn) -- | Unmute a user given their screen name unmuteUserRaw :: String -> FilePath -> IO BSL.ByteString -unmuteUserRaw screenName = postRequest ("https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" ++ screenName) +unmuteUserRaw sn = postRequest ("https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" ++ sn) -- | Unmute a user given their screen name unmuteUserRawMem :: String -> Config -> IO BSL.ByteString -unmuteUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" ++ screenName) +unmuteUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" ++ sn) -- | Get user's DMs. +getDMsRaw :: Show p => p -> FilePath -> IO BSL.ByteString getDMsRaw count = getRequest ("https://api.twitter.com/1.1/direct_messages.json" ++ requestString) where requestString = "?count=" ++ (show count) @@ -254,22 +255,23 @@ -- | Favorite a tweet given its id; return bytestring response favoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString -favoriteTweetRaw id = postRequest ("https://api.twitter.com/1.1/favorites/create.json?id=" ++ (show id)) +favoriteTweetRaw idNum = postRequest ("https://api.twitter.com/1.1/favorites/create.json?id=" ++ (show idNum)) --- | Favorite a tweet given its id; return bytestring response +-- | Favorite a tweet given its idNum; return bytestring response favoriteTweetRawMem :: Integer -> Config -> IO BSL.ByteString -favoriteTweetRawMem id = postRequestMem ("https://api.twitter.com/1.1/favorites/create.json?id=" ++ (show id)) +favoriteTweetRawMem idNum = postRequestMem ("https://api.twitter.com/1.1/favorites/create.json?id=" ++ (show idNum)) --- | Retweet a tweet given its id; return bytestring response +-- | Retweet a tweet given its idNum; return bytestring response retweetTweetRaw :: Integer -> FilePath -> IO BSL.ByteString -retweetTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/retweet/" ++ (show id) ++ ".json") +retweetTweetRaw idNum = postRequest ("https://api.twitter.com/1.1/statuses/retweet/" ++ (show idNum) ++ ".json") --- | Retweet a tweet given its id; return bytestring response +-- | Retweet a tweet given its idNum; return bytestring response retweetTweetRawMem :: Integer -> Config -> IO BSL.ByteString -retweetTweetRawMem id = postRequestMem ("https://api.twitter.com/1.1/statuses/retweet/" ++ (show id) ++ ".json") +retweetTweetRawMem idNum = postRequestMem ("https://api.twitter.com/1.1/statuses/retweet/" ++ (show idNum) ++ ".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") +sendDMRaw :: String -> [Char] -> FilePath -> IO BSL.ByteString +sendDMRaw txt sn = postRequest ("https://api.twitter.com/1.1/direct_messages/new.json?text=" ++ encoded ++ "&screen_name" ++ sn ++ ".json") where encoded = strEncode txt -- | Get DMs, return bytestring of response @@ -282,56 +284,56 @@ -- | Follow a user given their screen name followUserRaw :: String -> FilePath -> IO BSL.ByteString -followUserRaw screenName = postRequest ("https://api.twitter.com/1.1/friendships/create.json?screen_name=" ++ screenName) +followUserRaw sn = postRequest ("https://api.twitter.com/1.1/friendships/create.json?screen_name=" ++ sn) -- | Follow a user given their screen name followUserRawMem :: String -> Config -> IO BSL.ByteString -followUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/friendships/create.json?screen_name=" ++ screenName) +followUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/friendships/create.json?screen_name=" ++ sn) -- | Block a user given their screen name blockUserRaw :: String -> FilePath -> IO BSL.ByteString -blockUserRaw screenName = postRequest ("https://api.twitter.com/1.1/blocks/create.json?screen_name=" ++ screenName) +blockUserRaw sn = postRequest ("https://api.twitter.com/1.1/blocks/create.json?screen_name=" ++ sn) -- | Block a user given their screen name blockUserRawMem :: String -> Config -> IO BSL.ByteString -blockUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/blocks/create.json?screen_name=" ++ screenName) +blockUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/blocks/create.json?screen_name=" ++ sn) -- | Unblock a user given their screen name unblockUserRaw :: String -> FilePath -> IO BSL.ByteString -unblockUserRaw screenName = postRequest ("https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" ++ screenName) +unblockUserRaw sn = postRequest ("https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" ++ sn) -- | Unblock a user given their screen name unblockUserRawMem :: String -> Config -> IO BSL.ByteString -unblockUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" ++ screenName) +unblockUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" ++ sn) -- | Follow a user given their screen name unfollowUserRaw :: String -> FilePath -> IO BSL.ByteString -unfollowUserRaw screenName = postRequest ("https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" ++ screenName) +unfollowUserRaw sn = postRequest ("https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" ++ sn) -- | Follow a user given their screen name unfollowUserRawMem :: String -> Config -> IO BSL.ByteString -unfollowUserRawMem screenName = postRequestMem ("https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" ++ screenName) +unfollowUserRawMem sn = postRequestMem ("https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" ++ sn) -- | Unretweet a tweet given its id; return bytestring response unretweetTweetRaw :: Integer -> FilePath -> IO BSL.ByteString -unretweetTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/unretweet/" ++ (show id) ++ ".json") +unretweetTweetRaw idNum = postRequest ("https://api.twitter.com/1.1/statuses/unretweet/" ++ (show idNum) ++ ".json") --- | Unretweet a tweet given its id; return bytestring response +-- | Unretweet a tweet given its idNum; return bytestring response unretweetTweetRawMem :: Integer -> Config -> IO BSL.ByteString -unretweetTweetRawMem id = postRequestMem ("https://api.twitter.com/1.1/statuses/unretweet/" ++ (show id) ++ ".json") +unretweetTweetRawMem idNum = postRequestMem ("https://api.twitter.com/1.1/statuses/unretweet/" ++ (show idNum) ++ ".json") --- | Unfavorite a tweet given its id; return bytestring response +-- | Unfavorite a tweet given its idNum; return bytestring response unfavoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString -unfavoriteTweetRaw id = postRequest ("https://api.twitter.com/1.1/favorites/destroy.json?id=" ++ (show id)) +unfavoriteTweetRaw idNum = postRequest ("https://api.twitter.com/1.1/favorites/destroy.json?id=" ++ (show idNum)) --- | Unfavorite a tweet given its id; return bytestring response +-- | Unfavorite a tweet given its idNum; return bytestring response unfavoriteTweetRawMem :: Integer -> Config -> IO BSL.ByteString -unfavoriteTweetRawMem id = postRequestMem ("https://api.twitter.com/1.1/favorites/destroy.json?id=" ++ (show id)) +unfavoriteTweetRawMem idNum = postRequestMem ("https://api.twitter.com/1.1/favorites/destroy.json?id=" ++ (show idNum)) --- | Delete a tweet given its id; return bytestring response +-- | Delete a tweet given its idNum; return bytestring response deleteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString -deleteTweetRaw id = postRequest ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show id) ++ ".json") +deleteTweetRaw idNum = postRequest ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show idNum) ++ ".json") --- | Delete a tweet given its id; return bytestring response +-- | Delete a tweet given its idNum; return bytestring response deleteTweetRawMem :: Integer -> Config -> IO BSL.ByteString -deleteTweetRawMem id = postRequestMem ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show id) ++ ".json") +deleteTweetRawMem idNum = postRequestMem ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show idNum) ++ ".json") diff --git a/src/Web/Tweet/API/Internal.hs b/src/Web/Tweet/API/Internal.hs --- a/src/Web/Tweet/API/Internal.hs +++ b/src/Web/Tweet/API/Internal.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | Helper functions for the command line tool. module Web.Tweet.API.Internal where @@ -12,15 +10,15 @@ -- | 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 = fmap (showTweets color) . getProfile screenName count +showProfile sn count color = fmap (showTweets color) . getProfile sn count -- | Show the most successful tweets by a given user, given their screen name. showBest :: String -> Int -> Bool -> FilePath -> IO String -showBest screenName n color = fmap (showTweets color . pure . (take n . hits)) . getAll screenName Nothing +showBest sn n color = fmap (showTweets color . pure . (take n . hits)) . getAll sn Nothing -- | Show the most successful tweets by a given user, given their screen name. Additionally filter out replies. showBest' :: String -> Int -> Bool -> FilePath -> IO String -showBest' screenName n color = fmap (showTweets color . pure . (take n . hits')) . getAll screenName Nothing +showBest' sn n color = fmap (showTweets color . pure . (take n . hits')) . getAll sn Nothing -- | Display user timeline showTimeline :: Int -> Bool -> FilePath -> IO String diff --git a/src/Web/Tweet/Exec.hs b/src/Web/Tweet/Exec.hs --- a/src/Web/Tweet/Exec.hs +++ b/src/Web/Tweet/Exec.hs @@ -18,24 +18,24 @@ -- | Data type for a command -- TODO add boolean option to show ids alongside tweets data Command = Timeline { count :: Maybe Int } - | SendInput { tweetInputs :: Maybe Int, replyId :: Maybe String, replyHandles :: Maybe [String] } - | Profile { count :: Maybe Int , screenNameMaybe :: Maybe String } + | SendInput { tweetInputs :: Maybe Int, replyId :: Maybe String, replyh :: Maybe [String] } + | Profile { count :: Maybe Int , screenName'' :: Maybe String } | Mentions { count :: Maybe Int } - | Markov { screenName :: String } - | Send { tweets :: Maybe Int , replyId :: Maybe String , replyHandles :: Maybe [String] , userInput :: String } - | Sort { screenName :: String , count :: Maybe Int , includeReplies :: Bool } + | Markov { screenName' :: String } + | Send { tweets :: Maybe Int , replyId :: Maybe String , replyh :: Maybe [String] , userInput :: String } + | Sort { screenName' :: String , count :: Maybe Int , includeReplies :: Bool } | Delete { twId :: Integer } | Fav { twId :: Integer } | Unfav { twId :: Integer } | Retweet { twId :: Integer } | Unretweet { twId :: Integer } - | Follow { screenName :: String } - | Unfollow { screenName :: String } - | Block { screenName :: String } - | Unblock { screenName :: String } - | Mute { screenName :: String } - | Unmute { screenName :: String } - | Dump { screenName :: String } + | Follow { screenName' :: String } + | Unfollow { screenName' :: String } + | Block { screenName' :: String } + | Unblock { screenName' :: String } + | Mute { screenName' :: String } + | Unmute { screenName' :: String } + | Dump { screenName' :: String } -- | query twitter to post stdin with no fancy options fromStdIn :: Int -> FilePath -> IO () @@ -43,7 +43,7 @@ -- | Tweet string given to us, as parsed from the command line fromCLI :: String -> Int -> FilePath -> IO () -fromCLI str = thread str [] Nothing +fromCLI s = thread s [] Nothing -- | Threaded tweetInputs from stdIn threadStdIn :: [String] -> Maybe Int -> Int -> FilePath -> IO () @@ -63,62 +63,63 @@ -- | Executes program given parsed `Program` select :: Program -> IO () -select (Program com maybeFile color) = case maybeFile of - (Just file) -> selectCommand com (not color) file - _ -> selectCommand com (not color) =<< (++ "/.cred.toml") <$> getHomeDirectory +select (Program com maybeFile c) = case maybeFile of + (Just file) -> selectCommand com (not c) file + _ -> selectCommand com (not c) =<< (++ "/.cred.toml") <$> getHomeDirectory -- | Executes subcommand given subcommand + filepath to configuration file selectCommand :: Command -> Bool -> FilePath -> IO () selectCommand (Send maybeNum Nothing Nothing input) _ file = fromCLI input (fromMaybe 15 maybeNum) file -selectCommand (Send maybeNum (Just replyId) Nothing input) _ file = thread input [] (pure . read $ replyId) (fromMaybe 15 maybeNum) file -selectCommand (Send maybeNum Nothing (Just handles) input) _ file = thread input handles Nothing (fromMaybe 15 maybeNum) file +selectCommand (Send maybeNum (Just rId) Nothing input) _ file = thread input [] (pure . read $ rId) (fromMaybe 15 maybeNum) file +selectCommand (Send maybeNum Nothing (Just h) input) _ file = thread input h Nothing (fromMaybe 15 maybeNum) file +selectCommand (Send maybeNum (Just rId) (Just h) input) _ file = thread input h (pure . read $ rId) (fromMaybe 15 maybeNum) file selectCommand (SendInput maybeNum Nothing Nothing) _ file = fromStdIn (fromMaybe 15 maybeNum) file -selectCommand (SendInput maybeNum (Just replyId) (Just handles)) _ file = threadStdIn handles (pure . read $ replyId) (fromMaybe 15 maybeNum) file -selectCommand (SendInput maybeNum (Just replyId) Nothing) _ file = threadStdIn [] (pure . read $ replyId) (fromMaybe 15 maybeNum) file -selectCommand (SendInput maybeNum Nothing (Just handles)) _ file = threadStdIn handles Nothing (fromMaybe 15 maybeNum) file -selectCommand (Timeline maybeNum) color file = putStrLn =<< showTimeline (fromMaybe 11 maybeNum) color file -selectCommand (Mentions maybeNum) color file = putStrLn =<< showTweets color <$> mentions (fromMaybe 11 maybeNum) file -selectCommand (Profile maybeNum name) color file = putStrLn =<< showProfile (fromMaybe mempty name) (fromMaybe 11 maybeNum) color file -selectCommand (Sort name maybeNum False) color file = putStrLn =<< showBest' name (fromMaybe 11 maybeNum) color file -selectCommand (Sort name maybeNum True) color file = putStrLn =<< showBest name (fromMaybe 11 maybeNum) color file -selectCommand (Markov name) _ file = do - raw <- getMarkov name Nothing file - appendFile (name ++ ".txt") (unlines raw) - putStrLn $ "Written output to: " ++ name ++ ".txt" -selectCommand (Delete n) color file = do +selectCommand (SendInput maybeNum (Just rId) (Just h)) _ file = threadStdIn h (pure . read $ rId) (fromMaybe 15 maybeNum) file +selectCommand (SendInput maybeNum (Just rId) Nothing) _ file = threadStdIn [] (pure . read $ rId) (fromMaybe 15 maybeNum) file +selectCommand (SendInput maybeNum Nothing (Just h)) _ file = threadStdIn h Nothing (fromMaybe 15 maybeNum) file +selectCommand (Timeline maybeNum) c file = putStrLn =<< showTimeline (fromMaybe 11 maybeNum) c file +selectCommand (Mentions maybeNum) c file = putStrLn =<< showTweets c <$> mentions (fromMaybe 11 maybeNum) file +selectCommand (Profile maybeNum n) c file = putStrLn =<< showProfile (fromMaybe mempty n) (fromMaybe 11 maybeNum) c file +selectCommand (Sort n maybeNum False) c file = putStrLn =<< showBest' n (fromMaybe 11 maybeNum) c file +selectCommand (Sort n maybeNum True) c file = putStrLn =<< showBest n (fromMaybe 11 maybeNum) c file +selectCommand (Markov n) _ file = do + raw <- getMarkov n Nothing file + appendFile (n ++ ".txt") (unlines raw) + putStrLn $ "Written output to: " ++ n ++ ".txt" +selectCommand (Delete n) c file = do putStrLn "Deleted:\n" - putStrLn =<< showTweets color <$> deleteTweetResponse n file -selectCommand (Fav n) color file = do + putStrLn =<< showTweets c <$> deleteTweetResponse n file +selectCommand (Fav n) c file = do putStrLn "Favorited:\n" - putStrLn =<< showTweets color <$> favoriteTweetResponse n file -selectCommand (Unfav n) color file = do + putStrLn =<< showTweets c <$> favoriteTweetResponse n file +selectCommand (Unfav n) c file = do putStrLn "Unfavorited:\n" - putStrLn =<< showTweets color <$> unfavoriteTweetResponse n file -selectCommand (Retweet n) color file = do + putStrLn =<< showTweets c <$> unfavoriteTweetResponse n file +selectCommand (Retweet n) c file = do putStrLn "Retweeted:\n" - putStrLn =<< showTweets color <$> retweetTweetResponse n file -selectCommand (Unretweet n) color file = do + putStrLn =<< showTweets c <$> retweetTweetResponse n file +selectCommand (Unretweet n) c file = do putStrLn "Unretweeted:\n" - putStrLn =<< showTweets color <$> unretweetTweetResponse n file -selectCommand (Follow screenName) _ file = do - follow screenName file - putStrLn ("..." ++ screenName ++ " followed successfully!") -selectCommand (Unfollow screenName) _ file = do - unfollow screenName file - putStrLn ("..." ++ screenName ++ " unfollowed successfully!") -selectCommand (Block screenName) color file = do - block screenName file - putStrLn ("..." ++ screenName ++ " blocked successfully") -selectCommand (Unblock screenName) color file = do - unblock screenName file - putStrLn ("..." ++ screenName ++ " unblocked successfully") -selectCommand (Mute screenName) color file = do - mute screenName file - putStrLn ("..." ++ screenName ++ " muted successfully") -selectCommand (Unmute screenName) color file = do - unmute screenName file - putStrLn ("..." ++ screenName ++ " unmuted successfully") -selectCommand (Dump screenName) color file = BSL.putStrLn =<< (getProfileRaw screenName 3200 file Nothing) + putStrLn =<< showTweets c <$> unretweetTweetResponse n file +selectCommand (Follow sn) _ file = do + follow sn file + putStrLn ("..." ++ sn ++ " followed successfully!") +selectCommand (Unfollow sn) _ file = do + unfollow sn file + putStrLn ("..." ++ sn ++ " unfollowed successfully!") +selectCommand (Block sn) _ file = do + block sn file + putStrLn ("..." ++ sn ++ " blocked successfully") +selectCommand (Unblock sn) _ file = do + unblock sn file + putStrLn ("..." ++ sn ++ " unblocked successfully") +selectCommand (Mute sn) _ file = do + mute sn file + putStrLn ("..." ++ sn ++ " muted successfully") +selectCommand (Unmute sn) _ file = do + unmute sn file + putStrLn ("..." ++ sn ++ " unmuted successfully") +selectCommand (Dump sn) _ file = BSL.putStrLn =<< (getProfileRaw sn 3200 file Nothing) -- | Parser to return a program datatype program :: Parser Program @@ -278,7 +279,7 @@ (long "handle" <> short 'h' <> metavar "HANDLE1" - <> help "Handles to include in replies"))) + <> help "h to include in replies"))) <*> (unwords <$> (some $ argument str (metavar "TEXT" <> help "text of tweet to be sent"))) @@ -297,4 +298,4 @@ <> help "id of status to reply to - be sure to include their handle, e.g. @my_build_errors")) <*> (optional (some $ argument str (metavar "HANDLE1" - <> help "handles to include in replies"))) + <> help "h to include in replies"))) diff --git a/src/Web/Tweet/Parser.hs b/src/Web/Tweet/Parser.hs --- a/src/Web/Tweet/Parser.hs +++ b/src/Web/Tweet/Parser.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} {-# LANGUAGE OverloadedStrings #-} -- | Module containing parsers for tweet and response data. module Web.Tweet.Parser ( parseTweet @@ -22,14 +23,14 @@ parseTweet :: Parser Timeline parseTweet = many (try getData <|> (const (TweetEntity "" "" "" 0 mempty Nothing 0 0) <$> eof)) --- | Parse a single tweet's: name, text, fave count, retweet count +-- | Parse a single tweet's: n, text, fave count, retweet count getData :: Parser TweetEntity getData = do - id <- read <$> filterStr "id" - text <- filterStr "text" + idNum <- read <$> filterStr "id" + t <- filterStr "text" skipMentions - name <- filterStr "name" - screenName' <- filterStr "screen_name" + n <- filterStr "name" + screenn' <- filterStr "screen_name" --withheldCountries <- (catMaybes . sequence) <$> optional filterList let withheldCountries = mempty --let toBlock = "DE" `elem` (catMaybes (sequence bannedList)) @@ -38,12 +39,13 @@ "false" -> do rts <- read <$> filterStr "retweet_count" faves <- read <$> filterStr "favorite_count" - pure (TweetEntity text name screenName' id withheldCountries Nothing rts faves) + pure (TweetEntity t n screenn' idNum withheldCountries Nothing rts faves) "true" -> do - quoted <- parseQuoted + q <- parseQuoted rts <- read <$> filterStr "retweet_count" faves <- read <$> filterStr "favorite_count" - pure $ TweetEntity text name screenName' id withheldCountries quoted rts faves + pure $ TweetEntity t n screenn' idNum withheldCountries q rts faves + _ -> error "is_quote_status must have a value of \"true\" or \"false\"" -- | Parse a the quoted tweet parseQuoted :: Parser (Maybe TweetEntity) @@ -51,7 +53,7 @@ optional (string ",\"quoted_status_id" >> filterStr "quoted_status_id_str") -- FIXME it's skipping too many? prob is when two are deleted in a row twitter just dives in to RTs contents <- optional $ string "\",\"quoted_status" case contents of - (Just contents) -> pure <$> getData + (Just _) -> pure <$> getData _ -> pure Nothing @@ -59,7 +61,7 @@ skipInsideBrackets :: Parser () skipInsideBrackets = void (between (char '[') (char ']') $ many (skipInsideBrackets <|> void (noneOf ("[]" :: String)))) --- | Skip user mentions field to avoid parsing the wrong name +-- | Skip user mentions field to avoid parsing the wrong n skipMentions :: Parser () skipMentions = do many $ try $ anyChar >> notFollowedBy (string "\"user_mentions\":") @@ -75,18 +77,21 @@ char ',' filterTag str +{- filterList :: Parser [String] filterList = try $ do many $ try $ anyChar >> notFollowedBy (string ("\"withheld_in_countries\":")) char ',' filterWithheld + filterWithheld :: Parser [String] filterWithheld = do string "\"withheld_in_countries\":[\"" codes <- some $ do { char '\"' ; interior <- many (noneOf ("\"]" :: String)) ; char '\"' ; optional (char ',') ; pure interior } char ']' pure codes + -} -- | Parse a field given its tag filterTag :: String -> Parser String @@ -112,19 +117,22 @@ emojiChar :: Parser Char emojiChar = do - string "\\ud" + _ <- string "\\ud" str1 <- count 3 anyChar str2 <- string "\\ud" >> count 3 anyChar let num = decodeUtf16 $ "d" <> str1 <> "d" <> str2 pure . T.head $ num +decodeUtf16 :: String -> T.Text decodeUtf16 = TE.decodeUtf16BE . BS.concat . go where go [] = [] go (a:b:c:d:rest) = let sym = convert16 [a,b] [c,d] in sym : go rest + go _ = error "Internal error: decodeUtf16 failed." convert16 x y = BS.pack [(read . ("0x"<>)) x, (read . ("0x"<>)) y] -- | helper function to ignore emoji +filterEmoji :: BS.ByteString -> BS.ByteString filterEmoji str = if BS.head str == (fromIntegral . fromEnum $ 'd') then "FFFD" else str -- | Parse HTML chars @@ -145,6 +153,6 @@ -- | Convert a string of four hexadecimal digits to an integer. fromHex :: BS.ByteString -> Integer -fromHex = fromRight . (parseMaybe (L.hexadecimal :: Parsec Void BS.ByteString Integer)) +fromHex = fromRight . parseMaybe (L.hexadecimal :: Parsec Void BS.ByteString Integer) where fromRight (Just a) = a fromRight _ = error "failed to parse hex" diff --git a/src/Web/Tweet/Parser/FastParser.hs b/src/Web/Tweet/Parser/FastParser.hs --- a/src/Web/Tweet/Parser/FastParser.hs +++ b/src/Web/Tweet/Parser/FastParser.hs @@ -15,7 +15,7 @@ import Web.Tweet.Types hiding (name, text) data FastTweet = FastTweet - { id :: !Int + { idNum :: !Int , text :: !T.Text , user :: User , quoted_status :: Maybe FastTweet @@ -32,7 +32,7 @@ instance FromJSON User fromFast :: FastTweet -> TweetEntity -fromFast FastTweet{..} = TweetEntity (unpack text) (unpack . name $ user) (unpack . screen_name $ user) id mempty (fmap fromFast quoted_status) retweet_count favorite_count +fromFast FastTweet{..} = TweetEntity (unpack text) (unpack . name $ user) (unpack . screen_name $ user) idNum mempty (fmap fromFast quoted_status) retweet_count favorite_count fastParse :: BS.ByteString -> Either String [FastTweet] fastParse = eitherDecode . BSL.fromStrict diff --git a/src/Web/Tweet/Sign.hs b/src/Web/Tweet/Sign.hs --- a/src/Web/Tweet/Sign.hs +++ b/src/Web/Tweet/Sign.hs @@ -4,21 +4,23 @@ module Web.Tweet.Sign ( signRequest , signRequestMem , mkConfig - , mkConfigToml ) where + , mkConfigToml + , oAuthMem + , credentialMem ) where -import Prelude hiding (lookup) -import Web.Tweet.Utils -import Web.Authenticate.OAuth -import Network.HTTP.Client -import Web.Tweet.Types -import Text.Toml -import Text.Toml.Types -import Data.HashMap.Lazy -import qualified Data.Text as T -import qualified Data.Text.IO as TIO -import Data.Text.Encoding (encodeUtf8) -import Data.Monoid -import Data.ByteString as BS +import Data.ByteString as BS +import Data.HashMap.Lazy +import Data.Monoid +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text.IO as TIO +import Network.HTTP.Client +import Prelude hiding (lookup) +import Text.Toml +import Text.Toml.Types +import Web.Authenticate.OAuth +import Web.Tweet.Types +import Web.Tweet.Utils -- | Sign a request using your OAuth dev token, as stored in a config file. -- Uses the IO monad because signatures require a timestamp @@ -29,17 +31,28 @@ signRequestMem :: Config -> Request -> IO Request signRequestMem = uncurry signOAuth +-- | Create an OAuth api key from two ByteStrings. +oAuthMem :: BS.ByteString -- ^ API key + -> BS.ByteString -- ^ API secret + -> OAuth +oAuthMem key secret = newOAuth { oauthConsumerKey = key, oauthConsumerSecret = secret, oauthServerName = "api.twitter.com" } + +credentialMem :: BS.ByteString -- ^ Token + -> BS.ByteString -- ^ Token secret + -> Credential +credentialMem = newCredential + -- | Create an OAuth api key from config data in a file oAuth :: FilePath -> IO OAuth oAuth filepath = do - secret <- (lineByKey "api-sec") <$> getConfigData filepath - key <- (lineByKey "api-key") <$> getConfigData filepath + secret <- lineByKey "api-sec" <$> getConfigData filepath + key <- lineByKey "api-key" <$> getConfigData filepath let url = "api.twitter.com" pure newOAuth { oauthConsumerKey = key , oauthConsumerSecret = secret , oauthServerName = url } getKey :: HashMap T.Text Node -> T.Text -> BS.ByteString getKey hm key = case lookup key hm of - (Just (VString key)) -> encodeUtf8 key + (Just (VString k)) -> encodeUtf8 k (Just _) -> error $ "Key: " <> T.unpack key <> " found in the config file, but it is not a string." Nothing -> error $ "Key: " <> T.unpack key <> " not found in config file." @@ -48,7 +61,7 @@ t <- TIO.readFile filepath let hm = case parseTomlDoc ("failed to read .toml at: " <> filepath) t of Right tab -> tab - Left e -> error (show e) + Left e -> error (show e) secret = getKey hm "api-sec" key = getKey hm "api-key" tok = getKey hm "tok" @@ -57,7 +70,7 @@ o = newOAuth { oauthConsumerKey = key , oauthConsumerSecret = secret , oauthServerName = url } c = newCredential tok tokSecret pure (o, c) - + -- | Given a filepath, parse the contents of the file and return a configuration. mkConfig :: FilePath -> IO Config mkConfig filepath = do @@ -68,5 +81,5 @@ -- | Create a new credential from a token and token secret credential :: FilePath -> IO Credential credential filepath = newCredential <$> token <*> secretToken - where token = (lineByKey "tok") <$> getConfigData filepath - secretToken = (lineByKey "tok-sec") <$> getConfigData filepath + where token = lineByKey "tok" <$> getConfigData filepath + secretToken = lineByKey "tok-sec" <$> getConfigData filepath diff --git a/src/Web/Tweet/Types.hs b/src/Web/Tweet/Types.hs --- a/src/Web/Tweet/Types.hs +++ b/src/Web/Tweet/Types.hs @@ -4,16 +4,16 @@ -- | Exports the `Tweet` type, a datatype for building tweets easily module Web.Tweet.Types where -import GHC.Generics -import Control.Lens -import Data.Default -import Web.Authenticate.OAuth +import Control.Lens +import Data.Default +import GHC.Generics +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 type for our request: consists of the status text, whether to trium u information in the response, the handles to mention, and optionally the id of the status to reply to. data Tweet = Tweet - { _status :: String - , _handles :: [String] - , _replyID :: Maybe Int + { _status :: String + , _handles :: [String] + , _replyID :: Maybe Int } deriving (Generic, Default) -- | Data type for tweets as they are returned @@ -64,7 +64,7 @@ -- | Lens for `TweetEntity` accessing the `_quoted` field. quoted :: Lens' TweetEntity (Maybe TweetEntity) -quoted f tweet@TweetEntity { _quoted = quot } = fmap (\quot' -> tweet { _quoted = quot'}) (f quot) +quoted f tweet@TweetEntity { _quoted = q } = fmap (\q' -> tweet { _quoted = q'}) (f q) -- | Lens for `TweetEntity` accessing the `_retweets` field. retweets :: Lens' TweetEntity Int diff --git a/src/Web/Tweet/Utils.hs b/src/Web/Tweet/Utils.hs --- a/src/Web/Tweet/Utils.hs +++ b/src/Web/Tweet/Utils.hs @@ -8,7 +8,8 @@ , displayTimelineColor , lineByKey , bird - , getConfigData ) where + , getConfigData + , filterQuotes ) where import Control.Composition import Control.Lens hiding (noneOf) @@ -54,9 +55,9 @@ -- | Display Timeline without color displayTimeline :: Timeline -> String -displayTimeline ((TweetEntity content user screenName idTweet _ Nothing rts fave):rest) = concat [user +displayTimeline ((TweetEntity content u sn idTweet _ Nothing rts fave):rest) = concat [u , " (" - , screenName + , sn , ")" ,":\n " ,fixNewline content @@ -71,9 +72,9 @@ , show idTweet ,"\n\n" ,displayTimeline rest] -displayTimeline ((TweetEntity content user screenName idTweet _ (Just quoted) rts fave):rest) = concat [user +displayTimeline ((TweetEntity content u sn idTweet _ (Just q) rts fave):rest) = concat [u , " (" - , screenName + , sn , ")" , ":\n " , fixNewline content @@ -85,12 +86,12 @@ , " " , show idTweet , "\n " - , _name quoted + , _name q , " (" - , _screenName quoted + , _screenName q , ")" , ": " - , _text quoted + , _text q , "\n\n" , displayTimeline rest] displayTimeline [] = [] @@ -100,9 +101,9 @@ -- | Display Timeline in color displayTimelineColor :: Timeline -> String -displayTimelineColor ((TweetEntity content user screenName idTweet countries Nothing rts fave):rest) = concat [toYellow user +displayTimelineColor ((TweetEntity content u sn idTweet _ Nothing rts fave):rest) = concat [toYellow u , " (" - , screenName + , sn , ")" , ":\n " , fixNewline content @@ -116,9 +117,9 @@ , toBlue (show idTweet) , "\n\n" , displayTimelineColor rest] -displayTimelineColor ((TweetEntity content user screenName idTweet countries (Just quoted) rts fave):rest) = concat [toYellow user +displayTimelineColor ((TweetEntity content u sn idTweet _ (Just q) rts fave):rest) = concat [toYellow u , " (" - , screenName + , sn , ")" , ":\n " , fixNewline content @@ -131,12 +132,12 @@ , " " , toBlue (show idTweet) , "\n " - , toYellow $ _name quoted + , toYellow $ _name q , " (" - , _screenName quoted + , _screenName q , ")" , ": " - , _text quoted + , _text q , "\n\n" , displayTimelineColor rest] displayTimelineColor [] = [] diff --git a/src/Web/Tweet/Utils/API.hs b/src/Web/Tweet/Utils/API.hs --- a/src/Web/Tweet/Utils/API.hs +++ b/src/Web/Tweet/Utils/API.hs @@ -9,18 +9,18 @@ , urlString , strEncode ) 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.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 +import Data.Char +import Data.Maybe +import qualified Data.Text as T +import Data.Text.Encoding +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Network.HTTP.Types.Status (statusCode) +import Web.Authenticate.OAuth +import Web.Tweet.Sign +import Web.Tweet.Types -- | Make a GET request to twitter given a request string getRequestMem :: String -> Config -> IO BSL.ByteString @@ -54,13 +54,13 @@ 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 +-- | 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 + 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 @@ -77,7 +77,7 @@ 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. +-- | 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,17 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -import qualified Data.ByteString as BS +-- import qualified Data.ByteString as BS +import Data.Monoid +import System.Environment import Test.Hspec import Web.Tweet.Parser.FastParser -import Web.Tweet.Sign -import Data.Monoid -import System.Environment -import Test.QuickCheck +import Web.Tweet.Sign main :: IO () main = hspec $ do describe "fastParse" $ do - file <- runIO $ BS.readFile "test/data" + -- file <- runIO $ BS.readFile "test/data" config <- runIO $ (<> "/.cred") <$> getEnv "HOME" configToml <- runIO $ (<> "/.cred.toml") <$> getEnv "HOME" parallel $ it "parses sample tweets wrong" $ do diff --git a/tweet-hs.cabal b/tweet-hs.cabal --- a/tweet-hs.cabal +++ b/tweet-hs.cabal @@ -1,5 +1,5 @@ name: tweet-hs -version: 1.0.1.3 +version: 1.0.1.4 synopsis: Command-line tool for twitter description: a Command Line Interface Tweeter homepage: https://github.com/vmchale/command-line-tweeter#readme @@ -24,9 +24,10 @@ Default: False } -Flag gold { - Description: Use the gold linker - Default: True +Flag development { + Description: Enable -Werror + Default: False + Manual: True } Flag parallel-gc { @@ -70,10 +71,9 @@ , aeson default-language: Haskell2010 default-extensions: LambdaCase - if flag(gold) - ghc-options: -optl-fuse-ld=gold - ld-options: -fuse-ld=gold - ghc-options: -fwarn-unused-imports + if flag(development) + ghc-options: -Werror + ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates executable tweet if flag(library) @@ -84,12 +84,11 @@ main-is: Main.hs if flag(llvm-fast) ghc-options: -fllvm -optlo-O3 -O3 - if flag(gold) - ghc-options: -optl-fuse-ld=gold - ld-options: -fuse-ld=gold if flag(parallel-gc) ghc-options: -rtsopts -with-rtsopts=-N - ghc-options: -threaded -O3 + if flag(development) + ghc-options: -Werror + ghc-options: -threaded -O3 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: base , tweet-hs default-language: Haskell2010 @@ -105,10 +104,9 @@ , megaparsec if flag(llvm-fast) ghc-options: -fllvm -optlo-O3 -O3 - if flag(gold) - ghc-options: -optl-fuse-ld=gold - ld-options: -fuse-ld=gold - ghc-options: -threaded -rtsopts -with-rtsopts=-N + if flag(development) + ghc-options: -Werror + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates default-language: Haskell2010 test-suite tweeths-test @@ -120,10 +118,9 @@ , hspec , QuickCheck , bytestring - if flag(gold) - ghc-options: -optl-fuse-ld=gold - ld-options: -fuse-ld=gold - ghc-options: -threaded -rtsopts -with-rtsopts=-N + if flag(development) + ghc-options: -Werror + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates default-language: Haskell2010 source-repository head