packages feed

tweet-hs 0.6.0.0 → 0.6.0.1

raw patch · 11 files changed

+345/−278 lines, 11 filesdep +hspec-megaparsecdep +megaparsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec-megaparsec, megaparsec

API changes (from Hackage documentation)

- Web.Tweet: mute :: String -> FilePath -> IO ()
- Web.Tweet: muteUserRaw :: String -> FilePath -> IO ByteString
- Web.Tweet: unmute :: String -> FilePath -> IO ()
- Web.Tweet: unmuteUserRaw :: String -> FilePath -> IO ByteString
- Web.Tweet.Exec: Mute :: String -> Command
- Web.Tweet.Exec: Unmute :: String -> Command
- Web.Tweet.Parser.FastParser: fromFast :: FastTweet -> TweetEntity
+ Web.Tweet.Parser: getData :: Parser TweetEntity
+ Web.Tweet.Parser: parseTweet :: Parser Timeline
- Web.Tweet: deleteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: deleteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: favoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: favoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: getProfile :: String -> Int -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either String Timeline)
+ Web.Tweet: getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: getTimeline :: Int -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: mentions :: Int -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: mentions :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: retweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: retweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: showTweets :: Bool -> Either String Timeline -> String
+ Web.Tweet: showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String
- Web.Tweet: unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
- Web.Tweet: unretweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)
+ Web.Tweet: unretweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)

Files

README.md view
@@ -76,21 +76,13 @@ ```  ### Sending tweets--To send a tweet:--```-tweet send "This is my tweet"-```--#### Input from stdin To tweet from stderr, run a command that pipes stderr to stdin, i.e.  ```-stack build &>/dev/null | tweet input+YOUR_BUILD_COMMAND 2>&1 >/dev/null | tweet input ``` -The `tweet` executable reads from stdin only, but you can view the options (replies, number of tweets to thread, etc.) with+The `tweet` executable reads from stdIn only, but you can view the options (replies, number of tweets to thread, etc.) with  ``` tweet --help
bench/Bench.hs view
@@ -1,17 +1,19 @@ module Main where -import           Criterion.Main-import qualified Data.ByteString             as BS-import           Web.Tweet.Parser.FastParser-+import Criterion.Main+import Text.Megaparsec+import Web.Tweet.Parser+import Web.Tweet.Parser.FastParser+import qualified Data.ByteString as BS -setupEnv = BS.readFile "test/data"+fun = parse parseTweet "" -fast = fmap (fmap fromFast) . fastParse+fast = fastParse  main = do-    defaultMain [-                env setupEnv $ \ ~file ->-                bgroup "fastParser"+    file <- BS.readFile "test/data"+    defaultMain [ bgroup "parseTweet"+                      [ bench "226" $ whnf fun file ]+                , bgroup "fastParser"                       [ bench "226" $ whnf fast file ]                 ]
src/Web/Tweet/API.hs view
@@ -3,24 +3,25 @@ -- | Module containing the functions directly dealing with twitter's API module Web.Tweet.API where -import           Control.Lens-import           Control.Monad import qualified Data.ByteString.Lazy.Char8 as BSL-import           Data.Composition-import           Web.Tweet.Types-import           Web.Tweet.Utils-import           Web.Tweet.Utils.API+import Web.Tweet.Types+import Web.Tweet.Utils+import Control.Monad+import Control.Lens+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+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+    if (Just lastId) == maxId then          pure []     else         do@@ -33,12 +34,12 @@ tweetData tweet filepath = do     let requestString = urlString tweet     bytes <- postRequest ("https://api.twitter.com/1.1/statuses/update.json" ++ requestString) filepath -- FIXME fix the coloration-    putStrLn $ displayTimelineColor . either (error "failed to parse tweet") id . getTweetsFast . BSL.toStrict $ bytes-    pure . (view tweetId) . head . either (error "failed to parse tweet") id . getTweetsFast . BSL.toStrict $ bytes+    putStrLn $ displayTimelineColor . either (error "failed to parse tweet") id . getTweets . BSL.toStrict $ bytes+    pure . (view tweetId) . head . either (error "failed to parse tweet") id . getTweets . BSL.toStrict $ bytes  -- | Gets user profile with max_id set.-getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either String Timeline)-getProfileMax = fmap (getTweetsFast . BSL.toStrict) .*** getProfileRaw+getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline)+getProfileMax = fmap (getTweets . BSL.toStrict) .*** getProfileRaw  -- | Gets user profile with max_id set. getProfileRaw :: String -> Int -> FilePath -> Maybe Int -> IO BSL.ByteString@@ -48,8 +49,8 @@         Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) }  -- | Get mentions and parse response as a list of tweets-mentions :: Int -> FilePath -> IO (Either String Timeline)-mentions = fmap (getTweetsFast . BSL.toStrict) .* mentionsRaw+mentions :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+mentions = fmap (getTweets . BSL.toStrict) .* mentionsRaw  -- | Gets mentions mentionsRaw :: Int -> FilePath -> IO BSL.ByteString@@ -57,24 +58,24 @@     where requestString = "?count=" ++ (show count)  -- | Get user profile given screen name and how many tweets to return-getProfile :: String -> Int -> FilePath -> IO (Either String Timeline)+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,+-- | 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 --- | Show the most successful tweets by a given user, given their screen name.+-- | 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  -- | Display user timeline showTimeline :: Int -> Bool -> FilePath -> IO String-showTimeline count color = (fmap (showTweets color)) . getTimeline count+showTimeline count color = (fmap (showTweets color)) . getTimeline count   -- | Display user timeline in color, as appropriate-showTweets :: Bool -> Either String Timeline -> String+showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline))  -- | Get user's DMs.@@ -82,8 +83,8 @@     where requestString = "?count=" ++ (show count)  -- | Get a timeline-getTimeline :: Int -> FilePath -> IO (Either String Timeline)-getTimeline = (fmap (getTweetsFast . BSL.toStrict)) .* getTimelineRaw+getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+getTimeline = (fmap (getTweets . BSL.toStrict)) .* getTimelineRaw  -- | Get a user's timeline and return response as a bytestring getTimelineRaw :: Int -> FilePath -> IO BSL.ByteString@@ -95,32 +96,32 @@ deleteTweet = (fmap void) . deleteTweetRaw  -- | Get response, i.e. the tweet deleted-deleteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)-deleteTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* deleteTweetRaw+deleteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+deleteTweetResponse = fmap (getTweets . BSL.toStrict) .* deleteTweetRaw  -- | Favorite a tweet given its id favoriteTweet :: Integer -> FilePath -> IO () favoriteTweet = (fmap void) . favoriteTweetRaw  -- | Favorite a tweet and returned the (parsed) response-favoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)-favoriteTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* favoriteTweetRaw+favoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+favoriteTweetResponse = fmap (getTweets . BSL.toStrict) .* favoriteTweetRaw  -- | Unfavorite a tweet given its id unfavoriteTweet :: Integer -> FilePath -> IO () unfavoriteTweet = (fmap void) . unfavoriteTweetRaw  -- | Unfavorite a tweet and returned the (parsed) response-unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)-unfavoriteTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* unfavoriteTweetRaw+unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+unfavoriteTweetResponse = fmap (getTweets . BSL.toStrict) .* unfavoriteTweetRaw  -- | Unretweet a tweet given its id unretweetTweet :: Integer -> FilePath -> IO () unretweetTweet = (fmap void) . unretweetTweetRaw  -- | Unretweet a tweet and returned the (parsed) response-unretweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)-unretweetTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* unretweetTweetRaw+unretweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+unretweetTweetResponse = fmap (getTweets . BSL.toStrict) .* unretweetTweetRaw  -- | Unfollow a user given their screen name unfollow :: String -> FilePath -> IO ()@@ -138,21 +139,13 @@ unblock :: String -> FilePath -> IO () unblock = (fmap void) . unblockUserRaw --- | Mute a user given their screen name-mute :: String -> FilePath -> IO ()-mute = (fmap void) . muteUserRaw---- | Unmute a user given their screen name-unmute :: String -> FilePath -> IO ()-unmute = (fmap void) . unmuteUserRaw- -- | Retweet a tweet given its id retweetTweet :: Integer -> FilePath -> IO () retweetTweet = (fmap void) . retweetTweetRaw  -- | Retweet a tweet and returned the (parsed) response-retweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline)-retweetTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* retweetTweetRaw+retweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline)+retweetTweetResponse = fmap (getTweets . BSL.toStrict) .* retweetTweetRaw  -- | Favorite a tweet given its id; return bytestring response favoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString@@ -173,14 +166,6 @@ -- | 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)---- | 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)---- | 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)  -- | Block a user given their screen name blockUserRaw :: String -> FilePath -> IO BSL.ByteString
src/Web/Tweet/Exec.hs view
@@ -3,14 +3,14 @@                       , Program (..)                       , Command (..)) where +import Web.Tweet+import Options.Applicative import qualified Data.ByteString.Lazy.Char8 as BSL-import           Data.Maybe-import           Data.Monoid                hiding (getAll)-import           Data.Version-import           Options.Applicative-import           Paths_tweet_hs-import           System.Directory-import           Web.Tweet+import Data.Monoid hiding (getAll)+import System.Directory+import Data.Maybe+import Paths_tweet_hs+import Data.Version  -- | 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. data Program = Program { subcommand :: Command , cred :: Maybe FilePath , color :: Bool }@@ -33,8 +33,6 @@     | 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@@ -64,8 +62,8 @@ -- | 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") <$> getHomeDirectory+    (Just file) -> selectCommand com color file+    _ -> selectCommand com color =<< (++ "/.cred") <$> getHomeDirectory  -- | Executes subcommand given subcommand + filepath to configuration file selectCommand :: Command -> Bool -> FilePath -> IO ()@@ -111,12 +109,6 @@ 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)  -- | Parser to return a program datatype@@ -144,12 +136,11 @@         (long "cred"         <> short 'c'         <> metavar "CREDENTIALS"-        <> completer (bashCompleter "file -o plusdirs")         <> help "path to credentials"))     <*> switch         (long "color"         <> short 'l'-        <> help "Turn off colorized terminal output.")+        <> help "Display timeline with colorized terminal output.")  -- | Parser for the view subcommand timeline :: Parser Command@@ -224,7 +215,7 @@         <> short 'n'         <> metavar "NUM"         <> help "Number of tweetInputs to fetch, default 12"))-    <*> optional user+    <*> optional user   -- | Parser for the mention subcommand mentionsParser :: Parser Command
+ src/Web/Tweet/Parser.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+-- FIXME make this module available under cabal file+-- | Module containing parsers for tweet and response data.+module Web.Tweet.Parser ( parseTweet+                        , getData ) where++import qualified Data.ByteString as BS+import Text.Megaparsec.ByteString+import Text.Megaparsec.Lexer as L+import Text.Megaparsec+import Web.Tweet.Types+import Data.Monoid+import qualified Data.Map as M+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+            quoted <- parseQuoted+            rts <- read <$> filterStr "retweet_count"+            faves <- read <$> filterStr "favorite_count"+            pure $ TweetEntity text name screenName' id quoted rts faves++-- | Parse a the quoted tweet+parseQuoted :: Parser (Maybe TweetEntity)+parseQuoted = do+    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+        _ -> pure Nothing+    ++-- | Skip a set of square brackets []+skipInsideBrackets :: Parser ()+skipInsideBrackets = void (between (char '[') (char ']') $ many (skipInsideBrackets <|> void (noneOf ("[]" :: String))))++-- | 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 ("\\\"" :: String) else ("\\\"," :: String)+    want <- many $ parseHTMLChar <|> noneOf forbidden <|> specialChar '\"' <|> specialChar '/' <|> newlineChar <|> unicodeChar -- TODO modify parsec to make this parallel?+    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 . BS.pack . map (fromIntegral . fromEnum) <$> count 4 anyChar+    pure . toEnum . fromIntegral $ num++-- | helper function to ignore emoji+filterEmoji str = if BS.head str == (fromIntegral . fromEnum $ 'd') then "FFFD" else str++-- | Parse HTML chars+parseHTMLChar :: Parser Char+parseHTMLChar = do+    char '&'+    innards <- many $ noneOf (";" :: String)+    char ';'+    pure . (\case +        (Just a) -> a +        Nothing -> '?') $ M.lookup innards (M.fromList [("amp",'&'),("gt",'>'),("lt",'<'),("quot",'"'),("euro",'€'),("ndash",'–'),("mdash",'—')])+++-- | 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 :: BS.ByteString -> Integer+fromHex = fromRight . (parse (L.hexadecimal :: Parser Integer) "")+    where fromRight (Right a) = a
src/Web/Tweet/Parser/FastParser.hs view
@@ -1,38 +1,32 @@-{-# LANGUAGE DeriveGeneric   #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric     #-}  module Web.Tweet.Parser.FastParser ( fastParse-                                   , fromFast                                    , FastTweet (..)                                    ) where -import           Data.Aeson-import qualified Data.ByteString      as BS+import GHC.Generics+import Data.Aeson+import qualified Data.Text as T import qualified Data.ByteString.Lazy as BSL-import           Data.Text            (unpack)-import qualified Data.Text            as T-import           GHC.Generics-import           Web.Tweet.Types      hiding (name, text)+import qualified Data.ByteString as BS+--import Data.Vector  data FastTweet = FastTweet-    { id             :: !Int-    , text           :: !T.Text-    , user           :: User-    , quoted_status  :: Maybe FastTweet-    , retweet_count  :: !Int+    { id :: !Int+    , text :: !T.Text+    , user :: User+    , quoted_status :: Maybe FastTweet+    , retweet_count :: !Int     , favorite_count :: !Int     } deriving (Generic, Eq, Show)  data User = User { name        :: !T.Text-                 , screen_name :: !T.Text }+                 , screen_name :: !T.Text }                   deriving (Generic, Eq, Show)  instance FromJSON FastTweet  instance FromJSON User -fromFast :: FastTweet -> TweetEntity-fromFast FastTweet{..} = TweetEntity (unpack text) (unpack . name $ user) (unpack . screen_name $ user) id (fmap fromFast quoted_status) retweet_count favorite_count--fastParse :: BS.ByteString -> Either String [FastTweet]+fastParse :: BS.ByteString -> Either String [FastTweet] -- (Vector FastTweet) fastParse = eitherDecode . BSL.fromStrict
src/Web/Tweet/Types.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric   #-} {-# LANGUAGE DeriveAnyClass  #-}+{-# LANGUAGE TemplateHaskell #-}  -- | Exports the `Tweet` type, a datatype for building tweets easily module Web.Tweet.Types where@@ -33,42 +34,6 @@ -- | Contains an 'OAuth' and a 'Credential'; encapsulates everything needed to sign a request. type Config = (OAuth, Credential) --- | Lens for `Tweet` accessing the `status` field.-status :: Lens' Tweet String-status f tweet@Tweet { _status = str } = fmap (\str' -> tweet { _status = str'}) (f str)---- | Lens for `Tweet` accessing the `handles` field.-handles :: Lens' Tweet [String]-handles f tweet@Tweet { _handles = hs } = fmap (\hs' -> tweet { _handles = hs'}) (f hs)---- | Lens for `Tweet` accessing the `_replyID` field.-replyID :: Lens' Tweet (Maybe Int)-replyID f tweet@Tweet { _replyID = reply } = fmap (\reply' -> tweet { _replyID = reply'}) (f reply)---- | Lens for `TweetEntity` accessing the `_text` field.-text :: Lens' TweetEntity String-text f tweet@TweetEntity { _text = txt } = fmap (\txt' -> tweet { _text = txt'}) (f txt)---- | Lens for `TweetEntity` accessing the `_name` field.-name :: Lens' TweetEntity String-name f tweet@TweetEntity { _name = nam } = fmap (\nam' -> tweet { _name = nam'}) (f nam)---- | Lens for `TweetEntity` accessing the `_screenName` field.-screenName :: Lens' TweetEntity String-screenName f tweet@TweetEntity { _screenName = scr } = fmap (\scr' -> tweet { _screenName = scr'}) (f scr)---- | Lens for `TweetEntity` accessing the `_tweetId` field.-tweetId :: Lens' TweetEntity Int -tweetId f tweet@TweetEntity { _tweetId = tw } = fmap (\tw' -> tweet { _tweetId = tw'}) (f tw)---- | 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)---- | Lens for `TweetEntity` accessing the `_retweets` field.-retweets :: Lens' TweetEntity Int -retweets f tweet@TweetEntity { _retweets = rts } = fmap (\rts' -> tweet { _retweets = rts'}) (f rts)+makeLenses ''Tweet --- | Lens for `TweetEntity` accessing the `_favorites` field.-favorites :: Lens' TweetEntity Int -favorites f tweet@TweetEntity { _favorites = fav } = fmap (\fav' -> tweet { _favorites = fav'}) (f fav)+makeLenses ''TweetEntity
src/Web/Tweet/Utils.hs view
@@ -1,24 +1,25 @@ -- | Miscellaneous functions that don't fit the project directly module Web.Tweet.Utils (     hits-  , getTweetsFast+  , getTweets   , displayTimeline   , displayTimelineColor   , lineByKey   , getConfigData ) where -import           Control.Lens                hiding (noneOf)-import qualified Data.ByteString             as BS2-import qualified Data.ByteString.Char8       as BS-import           Data.List-import           Data.List.Extra-import           Web.Tweet.Parser.FastParser hiding (text)-import           Web.Tweet.Types-import           Web.Tweet.Utils.Colors+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString as BS2+import Data.List+import Web.Tweet.Types+import Control.Lens hiding (noneOf)+import Web.Tweet.Utils.Colors+import Data.List.Extra+import Web.Tweet.Parser+import Text.Megaparsec  -- | filter out retweets, and sort by most successful. hits :: Timeline -> Timeline-hits = sortTweets . filterRTs+hits = sortTweets . filterRTs   -- | Filter out retweets filterRTs :: Timeline -> Timeline@@ -28,10 +29,9 @@ filterQuotes :: Timeline -> Timeline filterQuotes = filter ((==Nothing) . (view quoted)) --- | Get a list of tweets from a response, returning author, favorites, retweets, and content.--- This version uses aeson, which it's far faster, but also has worse error messages.-getTweetsFast :: BS2.ByteString -> Either String Timeline-getTweetsFast = fmap (fmap fromFast) . fastParse+-- | Get a list of tweets from a response, returning author, favorites, retweets, and content. +getTweets :: BS2.ByteString -> Either (ParseError Char Dec) Timeline+getTweets = parse parseTweet ""   -- | Display Timeline without color displayTimeline :: Timeline -> String@@ -39,81 +39,81 @@     , " ("     , screenName     , ")"-    ,":\n    "-    ,fixNewline content-    ,"\n    "-    ,"♥ "-    ,show fave-    ," ♺ "-    ,show rts+    ,":\n    " +    ,fixNewline content +    ,"\n    " +    ,"♥ " +    ,show fave +    ," ♺ " +    ,show rts      , "  "     , show idTweet-    ,"\n\n"+    ,"\n\n"      ,displayTimeline rest]-displayTimeline ((TweetEntity content user screenName idTweet (Just quoted) rts fave):rest) = concat [user+displayTimeline ((TweetEntity content user screenName idTweet (Just quoted) rts fave):rest) = concat [user      , " ("     , screenName     , ")"-    , ":\n    "-    , fixNewline content-    , "\n    "-    , "♥ "-    , show fave-    , " ♺ "-    , show rts+    , ":\n    " +    , fixNewline content +    , "\n    " +    , "♥ " +    , show fave +    , " ♺ " +    , show rts      , "  "     , show idTweet-    , "\n    "-    , _name quoted+    , "\n    " +    , _name quoted      , " ("     , _screenName quoted     , ")"-    , ": "-    , _text quoted-    , "\n\n"+    , ": " +    , _text quoted +    , "\n\n"      , displayTimeline rest] displayTimeline [] = []  -- | Display Timeline in color displayTimelineColor :: Timeline -> String-displayTimelineColor ((TweetEntity content user screenName idTweet Nothing rts fave):rest) = concat [toYellow user+displayTimelineColor ((TweetEntity content user screenName idTweet Nothing rts fave):rest) = concat [toYellow user      , " ("     , screenName     , ")"-    , ":\n    "+    , ":\n    "      , fixNewline content-    , "\n    "+    , "\n    "      , toRed "♥"     , " "-    , show fave-    , toGreen " ♺ "-    , show rts+    , show fave +    , toGreen " ♺ " +    , show rts      , "  "     , toBlue (show idTweet)-    , "\n\n"+    , "\n\n"      , displayTimelineColor rest]-displayTimelineColor ((TweetEntity content user screenName  idTweet (Just quoted) rts fave):rest) = concat [toYellow user+displayTimelineColor ((TweetEntity content user screenName  idTweet (Just quoted) rts fave):rest) = concat [toYellow user      , " ("     , screenName     , ")"-    , ":\n    "-    , fixNewline content-    , "\n    "+    , ":\n    " +    , fixNewline content +    , "\n    "      , toRed "♥"     , " "-    , show fave-    , toGreen " ♺ "-    , show rts+    , show fave +    , toGreen " ♺ " +    , show rts      , "  "     , toBlue (show idTweet)-    , "\n    "-    , toYellow $ _name quoted+    , "\n    " +    , toYellow $ _name quoted      , " ("     , _screenName quoted     , ")"-    , ": "-    , _text quoted-    , "\n\n"+    , ": " +    , _text quoted +    , "\n\n"      , displayTimelineColor rest] displayTimelineColor [] = [] 
stack.yaml view
@@ -1,39 +1,66 @@-resolver: lts-8.18+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-8.20++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages. packages:- - .- - extra-dep: true-   location:-       git: https://github.com/haskell/deepseq-       commit: 0b22c9825ef79c1ee41d2f19e7c997f5cdc93494- - extra-dep: true-   location:-       git: https://github.com/ekmett/semigroupoids.git-       commit: c3297f970658ae874db098190327ec742044a2e6- - extra-dep: true-   location:-       git: http://github.com/ekmett/lens.git-       commit: 7031e00f62a704a86c3149c75c1e2afc059af022- - extra-dep: true-   location:-       git: https://github.com/dreixel/syb.git-       commit: f584ecd525179778063df2eb02dc6bbe406d7e75-flags:-    tweet-hs:-        llvm-fast: true-        parallel-gc: false-ghc-options:-    tweet-hs: -fdiagnostics-color=always-allow-newer: true-compiler: ghc-8.2.0.20170507-compiler-check: match-exact-setup-info:- ghc:-  linux64:-   8.2.0.20170507:-    url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-deb8-linux.tar.xz-  macosx:-   8.2.0.20170507:-    url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-apple-darwin.tar.xz-  windows64:-   8.2.0.20170507:-    url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-unknown-mingw32.tar.xz+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.4"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
test/Spec.hs view
@@ -1,12 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} -import qualified Data.ByteString             as BS-import           Test.Hspec-import           Web.Tweet.Parser.FastParser+import Test.Hspec+import Test.Hspec.Megaparsec+import Text.Megaparsec+import Web.Tweet.Parser+import qualified Data.ByteString as BS+--+import Web.Tweet.Parser.FastParser +-- TODO make sure it's the right number of tweets as well main :: IO () main = hspec $ do+    describe "parseTweet" $ do+        file <- runIO $ BS.readFile "test/data"+        parallel $ it "parses sample tweets" $ do+            parse parseTweet "" `shouldSucceedOn` file+            {--     describe "fastParse" $ do         file <- runIO $ BS.readFile "test/data"         parallel $ it "parses sample tweets wrong" $ do-            fastParse "" `shouldBe` Left "Error in $: not enough input"+            fastParse "" `shouldBe` Left "some error idk"+            --}
tweet-hs.cabal view
@@ -1,5 +1,5 @@ name:                tweet-hs-version:             0.6.0.0+version:             0.6.0.1 synopsis:            Command-line tool for twitter description:         a Command Line Interface Tweeter homepage:            https://github.com/vmchale/command-line-tweeter#readme@@ -24,20 +24,11 @@   Default:     False } -Flag gold {-  Description: Use the gold linker-  Default:     True-}--Flag parallel-gc {-  Description: Use parallel garbage collector-  Default:     False-}- library   hs-source-dirs:      src   exposed-modules:     Web.Tweet                      , Web.Tweet.Exec+                     , Web.Tweet.Parser                      , Web.Tweet.Parser.FastParser   other-modules:       Web.Tweet.Types                      , Web.Tweet.Utils@@ -57,6 +48,7 @@                      , lens                      , data-default                      , text+                     , megaparsec                      , containers                      , ansi-wl-pprint                      , directory@@ -65,10 +57,8 @@                      , 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+  ghc-options:      -fwarn-unused-imports+  -- -fwarn-unused-binds   executable tweet   if flag(library)@@ -78,32 +68,27 @@   hs-source-dirs:      app   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+    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  benchmark tweeths-bench-  type:                exitcode-stdio-1.0-  hs-source-dirs:      bench-  main-is:             Bench.hs-  build-depends:       base-                       , criterion-                       , tweet-hs-                       , bytestring+  type:             exitcode-stdio-1.0+  hs-source-dirs:   bench+  main-is:          Bench.hs+  build-depends:    base+                  , criterion+                  , tweet-hs+                  , megaparsec+                  , bytestring   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-  default-language:    Haskell2010+    ghc-options:       -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3+  else+    ghc-options:       -threaded -rtsopts -with-rtsopts=-N -O3+  default-language: Haskell2010  test-suite tweeths-test   type:                exitcode-stdio-1.0@@ -112,13 +97,12 @@   build-depends:       base                      , tweet-hs                      , hspec+                     , hspec-megaparsec+                     , megaparsec                      , bytestring-  if flag(gold) -    ghc-options:       -optl-fuse-ld=gold-    ld-options:        -fuse-ld=gold   ghc-options:         -threaded -rtsopts -with-rtsopts=-N    default-language:    Haskell2010  source-repository head   type:     git-  location: https://hub.darcs.net/vmchale/tweet-hs+  location: https://github.com/vmchale/command-line-tweeter