diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -76,13 +76,21 @@ ``` ### 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. ``` -YOUR_BUILD_COMMAND 2>&1 >/dev/null | tweet input +stack build &>/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 diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -1,19 +1,17 @@ module Main where -import Criterion.Main -import Text.Megaparsec -import Web.Tweet.Parser -import Web.Tweet.Parser.FastParser -import qualified Data.ByteString as BS +import Criterion.Main +import qualified Data.ByteString as BS +import Web.Tweet.Parser.FastParser -fun = parse parseTweet "" -fast = fastParse +setupEnv = BS.readFile "test/data" +fast = fmap (fmap fromFast) . fastParse + main = do - file <- BS.readFile "test/data" - defaultMain [ bgroup "parseTweet" - [ bench "226" $ whnf fun file ] - , bgroup "fastParser" + defaultMain [ + env setupEnv $ \ ~file -> + bgroup "fastParser" [ bench "226" $ whnf fast file ] ] 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 @@ -3,25 +3,24 @@ -- | 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 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 +import Data.Composition +import Web.Tweet.Types +import Web.Tweet.Utils +import Web.Tweet.Utils.API -- | 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 @@ -34,12 +33,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 . getTweets . BSL.toStrict $ bytes - pure . (view tweetId) . head . either (error "failed to parse tweet") id . getTweets . BSL.toStrict $ bytes + 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 -- | Gets user profile with max_id set. -getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline) -getProfileMax = fmap (getTweets . BSL.toStrict) .*** getProfileRaw +getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either String Timeline) +getProfileMax = fmap (getTweetsFast . BSL.toStrict) .*** getProfileRaw -- | Gets user profile with max_id set. getProfileRaw :: String -> Int -> FilePath -> Maybe Int -> IO BSL.ByteString @@ -49,8 +48,8 @@ Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) } -- | Get mentions and parse response as a list of tweets -mentions :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline) -mentions = fmap (getTweets . BSL.toStrict) .* mentionsRaw +mentions :: Int -> FilePath -> IO (Either String Timeline) +mentions = fmap (getTweetsFast . BSL.toStrict) .* mentionsRaw -- | Gets mentions mentionsRaw :: Int -> FilePath -> IO BSL.ByteString @@ -58,24 +57,24 @@ where requestString = "?count=" ++ (show count) -- | Get user profile given screen name and how many tweets to return -getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline) +getProfile :: String -> Int -> FilePath -> IO (Either String 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 (ParseError Char Dec) Timeline -> String +showTweets :: Bool -> Either String Timeline -> String showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline)) -- | Get user's DMs. @@ -83,8 +82,8 @@ where requestString = "?count=" ++ (show count) -- | Get a timeline -getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline) -getTimeline = (fmap (getTweets . BSL.toStrict)) .* getTimelineRaw +getTimeline :: Int -> FilePath -> IO (Either String Timeline) +getTimeline = (fmap (getTweetsFast . BSL.toStrict)) .* getTimelineRaw -- | Get a user's timeline and return response as a bytestring getTimelineRaw :: Int -> FilePath -> IO BSL.ByteString @@ -96,32 +95,32 @@ deleteTweet = (fmap void) . deleteTweetRaw -- | Get response, i.e. the tweet deleted -deleteTweetResponse :: Integer -> FilePath -> IO (Either (ParseError Char Dec) Timeline) -deleteTweetResponse = fmap (getTweets . BSL.toStrict) .* deleteTweetRaw +deleteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline) +deleteTweetResponse = fmap (getTweetsFast . 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 (ParseError Char Dec) Timeline) -favoriteTweetResponse = fmap (getTweets . BSL.toStrict) .* favoriteTweetRaw +favoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline) +favoriteTweetResponse = fmap (getTweetsFast . 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 (ParseError Char Dec) Timeline) -unfavoriteTweetResponse = fmap (getTweets . BSL.toStrict) .* unfavoriteTweetRaw +unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either String Timeline) +unfavoriteTweetResponse = fmap (getTweetsFast . 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 (ParseError Char Dec) Timeline) -unretweetTweetResponse = fmap (getTweets . BSL.toStrict) .* unretweetTweetRaw +unretweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline) +unretweetTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* unretweetTweetRaw -- | Unfollow a user given their screen name unfollow :: String -> FilePath -> IO () @@ -139,13 +138,21 @@ 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 (ParseError Char Dec) Timeline) -retweetTweetResponse = fmap (getTweets . BSL.toStrict) .* retweetTweetRaw +retweetTweetResponse :: Integer -> FilePath -> IO (Either String Timeline) +retweetTweetResponse = fmap (getTweetsFast . BSL.toStrict) .* retweetTweetRaw -- | Favorite a tweet given its id; return bytestring response favoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString @@ -166,6 +173,14 @@ -- | 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 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 @@ -3,14 +3,14 @@ , Program (..) , Command (..)) where -import Web.Tweet -import Options.Applicative import qualified Data.ByteString.Lazy.Char8 as BSL -import Data.Monoid hiding (getAll) -import System.Directory -import Data.Maybe -import Paths_tweet_hs -import Data.Version +import Data.Maybe +import Data.Monoid hiding (getAll) +import Data.Version +import Options.Applicative +import Paths_tweet_hs +import System.Directory +import Web.Tweet -- | 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,6 +33,8 @@ | 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 @@ -109,6 +111,12 @@ 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 @@ -136,6 +144,7 @@ (long "cred" <> short 'c' <> metavar "CREDENTIALS" + <> completer (bashCompleter "file -o plusdirs") <> help "path to credentials")) <*> switch (long "color" @@ -215,7 +224,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 diff --git a/src/Web/Tweet/Parser.hs b/src/Web/Tweet/Parser.hs deleted file mode 100644 --- a/src/Web/Tweet/Parser.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# 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 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 @@ -1,32 +1,38 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} module Web.Tweet.Parser.FastParser ( fastParse + , fromFast , FastTweet (..) ) where -import GHC.Generics -import Data.Aeson -import qualified Data.Text as T +import Data.Aeson +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import qualified Data.ByteString as BS ---import Data.Vector +import Data.Text (unpack) +import qualified Data.Text as T +import GHC.Generics +import Web.Tweet.Types hiding (name, text) 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 -fastParse :: BS.ByteString -> Either String [FastTweet] -- (Vector FastTweet) +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 = eitherDecode . BSL.fromStrict 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 @@ -1,25 +1,24 @@ -- | Miscellaneous functions that don't fit the project directly module Web.Tweet.Utils ( hits - , getTweets + , getTweetsFast , displayTimeline , displayTimelineColor , lineByKey , getConfigData ) where -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 +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 -- | filter out retweets, and sort by most successful. hits :: Timeline -> Timeline -hits = sortTweets . filterRTs +hits = sortTweets . filterRTs -- | Filter out retweets filterRTs :: Timeline -> Timeline @@ -29,9 +28,10 @@ filterQuotes :: Timeline -> Timeline filterQuotes = filter ((==Nothing) . (view quoted)) --- | 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 "" +-- | 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 -- | 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 [] = [] diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,66 +1,39 @@ -# 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.17 - -# 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. +resolver: lts-8.18 packages: -- '.' -# 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 + - . + - 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,23 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} -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 +import qualified Data.ByteString as BS +import Test.Hspec +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 "some error idk" - --} + fastParse "" `shouldBe` Left "Error in $: not enough input" 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: 0.5.3.13 +version: 0.6.0.0 synopsis: Command-line tool for twitter description: a Command Line Interface Tweeter homepage: https://github.com/vmchale/command-line-tweeter#readme @@ -38,7 +38,6 @@ 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 @@ -58,7 +57,6 @@ , lens , data-default , text - , megaparsec , containers , ansi-wl-pprint , directory @@ -70,7 +68,7 @@ if flag(gold) ghc-options: -optl-fuse-ld=gold ld-options: -fuse-ld=gold - ghc-options: -fwarn-unused-imports + ghc-options: -fwarn-unused-imports executable tweet if flag(library) @@ -86,27 +84,26 @@ ld-options: -fuse-ld=gold if flag(parallel-gc) ghc-options: -rtsopts -with-rtsopts=-N - ghc-options: -threaded + ghc-options: -threaded -O3 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 - , megaparsec - , bytestring + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Bench.hs + build-depends: base + , criterion + , tweet-hs + , 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 -O3 - default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 test-suite tweeths-test type: exitcode-stdio-1.0 @@ -115,8 +112,6 @@ build-depends: base , tweet-hs , hspec - , hspec-megaparsec - , megaparsec , bytestring if flag(gold) ghc-options: -optl-fuse-ld=gold @@ -126,4 +121,4 @@ source-repository head type: git - location: https://github.com/vmchale/command-line-tweeter + location: https://hub.darcs.net/vmchale/tweet-hs