diff --git a/src/Web/Tweet.hs b/src/Web/Tweet.hs --- a/src/Web/Tweet.hs +++ b/src/Web/Tweet.hs @@ -56,6 +56,7 @@ import Web.Authenticate.OAuth import Web.Tweet.Sign import Data.List.Utils +import Text.Megaparsec.Error -- | thread tweets together nicely. Takes a string, a list of handles to reply to, plus the ID of the status you're replying to. -- If you need to thread tweets without replying, pass a `Nothing` as the third argument. @@ -107,37 +108,52 @@ responseInt request manager -- | Get tweets (text only) for some user -getRaw screenName filepath = do - let requestString = "?screen_name=" ++ screenName ++ "&count=3200" - manager <- newManager tlsManagerSettings - initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString) - request <- signRequest filepath $ initialRequest { method = "GET"} - let fromRight (Right a) = a - map (view text) . fromRight . getTweets . BSL.unpack <$> responseBS request manager +-- TODO make it recursive/have it read max_id from returned tweet. +getRaw :: String -> Maybe Int -> FilePath -> IO [String] +getRaw screenName maxId filepath = do + tweets <- either (error "Parse tweets failed") id <$> getProfileMax screenName 200 filepath maxId + let lastId = _tweetId . last $ tweets + if (Just lastId) == maxId then + pure [] + else + do + putStrLn $ "fetching tweets since " ++ show lastId ++ "..." + next <- getRaw screenName (Just lastId) filepath + pure ((map _text tweets) ++ next) --- | Get user profile given screen name and how many tweets to return -getProfile screenName count filepath = do - let requestString = "?screen_name=" ++ screenName ++ "&count=" ++ (show count) +getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseError Char Dec) Timeline) +getProfileMax screenName count filepath maxId = do + let requestString = case maxId of { + (Just id) -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) ++ "&max_id=" ++ (show id) ; + Nothing -> "?screen_name=" ++ screenName ++ "&count=" ++ (show count) } manager <- newManager tlsManagerSettings initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/user_timeline.json" ++ requestString) request <- signRequest filepath $ initialRequest { method = "GET"} responseBS request manager -- TODO getTweets . BSL.unpack <$> responseBS request manager +-- | Get user profile given screen name and how many tweets to return +getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline) +getProfile screenName count filepath = getProfileMax screenName count filepath Nothing + -- | Show your DMs, given how many to return and whether or not to use color. showDMs count color filepath = showTweets color <$> getDMs count filepath -- | Show a user profile given screen name, how many tweets to return (API -- maximum is 3200), and whether to print them in color. -showProfile :: Show t => String -> t -> Bool -> FilePath -> IO String +showProfile :: String -> Int -> Bool -> FilePath -> IO String showProfile screenName count color filepath = showTweets color <$> getProfile screenName count filepath -showBest screenName color filepath = showTweets color . (fmap (take 11 . hits)) <$> getProfile screenName 3200 filepath +-- | Show the most successful tweets by a given user, given their screen name. +showBest :: String -> Bool -> FilePath -> IO String +showBest screenName color filepath = showTweets color . (fmap (take 13 . hits)) <$> getProfile screenName 3200 filepath -- | Display user timeline +showTimeline :: Int -> Bool -> FilePath -> IO String showTimeline count color filepath = showTweets color <$> getTimeline count filepath -- | Display user timeline in color +showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline)) -- | Get user's DMs. @@ -149,6 +165,7 @@ getTweets . BSL.unpack <$> responseBS request manager -- | Get a timeline +getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline) getTimeline count filepath = do let requestString = "?count=" ++ (show count) manager <- newManager tlsManagerSettings @@ -169,8 +186,6 @@ response <- httpLbs request manager let code = statusCode $ responseStatus response putStr $ if (code == 200) then "" else "failed :(\n error code: " ++ (show code) ++ "\n" - -- print $ generalCategory ('📚') - -- print $ (toEnum (0x1F48C) :: Char) -- (0xF079) pure . responseBody $ response -- | print output of a request and return status id as an `Int`. 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 @@ -93,11 +93,13 @@ select (Program (Sort False name) (Just file)) = putStrLn =<< showBest name False file select (Program (Sort False name) Nothing) = putStrLn =<< showBest name False =<< (++ "/.cred") <$> getHomeDirectory select (Program (Raw name) Nothing) = do - raw <- getRaw name =<< (++ "/.cred") <$> getHomeDirectory - sequence_ $ putStrLn <$> raw + raw <- getRaw name Nothing =<< (++ "/.cred") <$> getHomeDirectory + writeFile (name ++ ".txt") (unlines raw) + putStrLn $ "Written output to: " ++ name ++ ".txt" select (Program (Raw name) (Just file)) = do - raw <- getRaw name file - sequence_ $ putStrLn <$> raw --fix this idk + raw <- getRaw name Nothing file + writeFile (name ++ ".txt") (unlines raw) + putStrLn $ "Written output to: " ++ name ++ ".txt" -- | Parser to return a program datatype program :: Parser Program 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 @@ -15,6 +15,7 @@ import Control.Lens hiding (noneOf) import Data.Function import Web.Tweet.Utils.Colors +import Data.List.Extra -- `FIXME` parseDMs = zip <$> (extractEvery 2 <$> filterStr "screen_name") <*> (filterStr "text") @@ -22,15 +23,18 @@ -- | Display Timeline without color displayTimeline :: Timeline -> String -displayTimeline ((TweetEntity content user _ _ Nothing fave rts):rest) = (user <> ":\n " <> content) <> "\n " <> "♥ " <> (show fave) <> " ♺ " <> (show rts) <> "\n\n" <> (displayTimeline rest) -displayTimeline ((TweetEntity content user _ _ (Just quoted) fave rts):rest) = (user <> ":\n " <> content) <> "\n " <> "♥ " <> (show fave) <> " ♺ " <> (show rts) <> "\n " <> (_name quoted) <> ": " <> (_text quoted) <> "\n\n" <> (displayTimeline rest) +displayTimeline ((TweetEntity content user _ _ Nothing fave rts):rest) = (user <> ":\n " <> (fixNewline content)) <> "\n " <> "♥ " <> (show fave) <> " ♺ " <> (show rts) <> "\n\n" <> (displayTimeline rest) +displayTimeline ((TweetEntity content user _ _ (Just quoted) fave rts):rest) = (user <> ":\n " <> (fixNewline content)) <> "\n " <> "♥ " <> (show fave) <> " ♺ " <> (show rts) <> "\n " <> (_name quoted) <> ": " <> (_text quoted) <> "\n\n" <> (displayTimeline rest) displayTimeline [] = [] -- | Display Timeline in color displayTimelineColor :: Timeline -> String -displayTimelineColor ((TweetEntity content user _ _ Nothing fave rts):rest) = ((toYellow user) <> ":\n " <> content) <> "\n " <> (toRed "♥ ") <> (show fave) <> (toGreen " ♺ ") <> (show rts) <> "\n\n" <> (displayTimelineColor rest) -displayTimelineColor ((TweetEntity content user _ _ (Just quoted) fave rts):rest) = ((toYellow user) <> ":\n " <> content) <> "\n " <> (toRed "♥ ") <> (show fave) <> (toGreen " ♺ ") <> (show rts) <> "\n " <> (toYellow $ _name quoted) <> ": " <> (_text quoted) <> "\n\n" <> (displayTimelineColor rest) +displayTimelineColor ((TweetEntity content user _ _ Nothing fave rts):rest) = ((toYellow user) <> ":\n " <> (fixNewline content)) <> "\n " <> (toRed "♥ ") <> (show fave) <> (toGreen " ♺ ") <> (show rts) <> "\n\n" <> (displayTimelineColor rest) +displayTimelineColor ((TweetEntity content user _ _ (Just quoted) fave rts):rest) = ((toYellow user) <> ":\n " <> (fixNewline content)) <> "\n " <> (toRed "♥ ") <> (show fave) <> (toGreen " ♺ ") <> (show rts) <> "\n " <> (toYellow $ _name quoted) <> ": " <> (_text quoted) <> "\n\n" <> (displayTimelineColor rest) displayTimelineColor [] = [] + +fixNewline :: String -> String +fixNewline = replace "\n" "\n " -- | Get a list of tweets from a response, returning author, favorites, retweets, and content. getTweets = parse parseTweet "" diff --git a/tweet-hs.cabal b/tweet-hs.cabal --- a/tweet-hs.cabal +++ b/tweet-hs.cabal @@ -1,70 +1,61 @@ -name: tweet-hs -version: 0.5.0.0 -cabal-version: >=1.10 -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: 2016 Vanessa McHale -maintainer: tmchale@wisc.edu -stability: stable -homepage: https://github.com/vmchale/command-line-tweeter#readme -synopsis: Post tweets from stdin -description: - a Command Line Interface Tweeter -category: Web -author: Vanessa McHale -extra-source-files: - README.md - stack.yaml - bash/mkCompletions - -source-repository head - type: git - location: https://github.com/vmchale/command-line-tweeter +name: tweet-hs +version: 0.5.0.1 +synopsis: Post tweets from stdin +description: a Command Line Interface Tweeter +homepage: https://github.com/vmchale/command-line-tweeter#readme +license: BSD3 +license-file: LICENSE +author: Vanessa McHale +maintainer: tmchale@wisc.edu +copyright: 2016 Vanessa McHale +category: Web +build-type: Simple +stability: stable +extra-source-files: README.md, stack.yaml, bash/mkCompletions +cabal-version: >=1.10 -flag llvm-fast - description: - Enable build with llvm backend - default: False +Flag llvm-fast { + Description: Enable build with llvm backend + Default: False +} library - exposed-modules: - Web.Tweet - Web.Tweet.Exec - build-depends: - base >=4.7 && <5, - http-client-tls >=0.3.4 && <0.4, - http-client >=0.5.6.1 && <0.6, - http-types >=0.9.1 && <0.10, - authenticate-oauth ==1.6.*, - bytestring >=0.10.8.1 && <0.11, - split >=0.2.3.1 && <0.3, - optparse-applicative >=0.13.2.0 && <0.14, - lens >=4.15.1 && <4.16, - data-default >=0.7.1.1 && <0.8, - text >=1.2.2.1 && <1.3, - megaparsec >=5.2.0 && <5.3, - ansi-wl-pprint >=0.6.7.3 && <0.7, - MissingH >=1.4.0.1 && <1.5, - directory >=1.3.0.0 && <1.4 - default-language: Haskell2010 - hs-source-dirs: src - other-modules: - Web.Tweet.Types - Web.Tweet.Utils - Web.Tweet.Utils.Colors - Web.Tweet.Sign + hs-source-dirs: src + exposed-modules: Web.Tweet + , Web.Tweet.Exec + other-modules: Web.Tweet.Types + , Web.Tweet.Utils + , Web.Tweet.Utils.Colors + , Web.Tweet.Sign + build-depends: base >= 4.7 && < 5 + , http-client-tls + , http-client + , http-types + , authenticate-oauth + , bytestring + , split + , optparse-applicative + , lens + , data-default + , text + , megaparsec + , ansi-wl-pprint + , MissingH + , directory + , extra + default-language: Haskell2010 executable tweet - - if flag(llvm-fast) - ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 - else - ghc-options: -threaded -rtsopts -with-rtsopts=-N - main-is: Main.hs - build-depends: - base >=4.9.1.0 && <4.10, - tweet-hs >=0.5.0.0 && <0.6 - default-language: Haskell2010 - hs-source-dirs: app + hs-source-dirs: app + main-is: Main.hs + if flag(llvm-fast) + ghc-options: -threaded -rtsopts -with-rtsopts=-N -fllvm -optlo-O3 -O3 + else + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , tweet-hs + default-language: Haskell2010 +source-repository head + type: git + location: https://github.com/vmchale/command-line-tweeter