tweet-hs 1.0.1.3 → 1.0.1.4

raw patch · 13 files changed

+257/−232 lines, 13 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/Bench.hs +7/−2
• src/Web/Tweet.hs +24/−23
• src/Web/Tweet/API.hs +43/−41
• src/Web/Tweet/API/Internal.hs +3/−5
• src/Web/Tweet/Exec.hs +62/−61
• src/Web/Tweet/Parser.hs +20/−12
• src/Web/Tweet/Parser/FastParser.hs +2/−2
• src/Web/Tweet/Sign.hs +34/−21
• src/Web/Tweet/Types.hs +9/−9
• src/Web/Tweet/Utils.hs +16/−15
• src/Web/Tweet/Utils/API.hs +15/−15
• test/Spec.hs +5/−6
• tweet-hs.cabal +17/−20

@@ -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+

@@ -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

@@ -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")

@@ -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

@@ -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")))

@@ -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"

@@ -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

@@ -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

@@ -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

@@ -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 [] = []

@@ -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

@@ -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

@@ -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