{-# LANGUAGE OverloadedStrings #-}

-- | Module containing the functions directly dealing with twitter's API. Most functions in this module have two versions - one which takes a path to a TOML file containing api keys/secrets and tokens/secrets, the other takes api keys/secrets and tokens/secrets as an argument.
module Web.Tweet.API where

import           Control.Composition
import           Control.Monad
import qualified Data.ByteString.Lazy.Char8 as BSL
import           Data.Containers.ListUtils  (nubOrd)
import           Data.Foldable              (traverse_)
import           Data.Functor               (($>))
import           Data.Maybe                 (isJust)
import qualified Data.Set                   as S
import           Data.Void
import           Lens.Micro
import           Lens.Micro.Extras
import           Text.Megaparsec.Error
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 :: String -> Maybe Int -> String -> IO [String]
getMarkov = ([TweetEntity] -> [String]) -> IO [TweetEntity] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TweetEntity -> String) -> [TweetEntity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Getting String TweetEntity String -> TweetEntity -> String
forall a s. Getting a s a -> s -> a
view Getting String TweetEntity String
Lens' TweetEntity String
text)) (IO [TweetEntity] -> IO [String])
-> (String -> Maybe Int -> String -> IO [TweetEntity])
-> String
-> Maybe Int
-> String
-> IO [String]
forall d e a b c.
(d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
.** String -> Maybe Int -> String -> IO [TweetEntity]
getAll

-- | Get all tweets by some user
getAll :: String -> Maybe Int -> FilePath -> IO Timeline
getAll :: String -> Maybe Int -> String -> IO [TweetEntity]
getAll String
sn Maybe Int
maxId String
filepath = do
    [TweetEntity]
tweets <- (ParseErrorBundle String Void -> [TweetEntity])
-> ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> [TweetEntity]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseErrorBundle String Void -> [TweetEntity]
forall a. HasCallStack => String -> a
error String
"Parse tweets failed") [TweetEntity] -> [TweetEntity]
forall a. a -> a
id (Either (ParseErrorBundle String Void) [TweetEntity]
 -> [TweetEntity])
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
-> IO [TweetEntity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Int
-> String
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getProfileMax String
sn Int
200 String
filepath Maybe Int
maxId
    let lastId :: Maybe Int
lastId = TweetEntity -> Int
_tweetId (TweetEntity -> Int) -> Maybe TweetEntity -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TweetEntity]
tweets [TweetEntity]
-> Getting (First TweetEntity) [TweetEntity] TweetEntity
-> Maybe TweetEntity
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First TweetEntity) [TweetEntity] TweetEntity
forall s a. Snoc s s a a => Traversal' s a
_last
    if Maybe Int
lastId Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
maxId then
        [TweetEntity] -> IO [TweetEntity]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else
        do
            if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
lastId
                then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"fetching tweets since " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Maybe Int
lastId Maybe Int -> Getting (Endo Int) (Maybe Int) Int -> Int
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo Int) (Maybe Int) Int
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
                else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            [TweetEntity]
next <- String -> Maybe Int -> String -> IO [TweetEntity]
getAll String
sn Maybe Int
lastId String
filepath
            [TweetEntity] -> IO [TweetEntity]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TweetEntity]
tweets [TweetEntity] -> [TweetEntity] -> [TweetEntity]
forall a. [a] -> [a] -> [a]
++ [TweetEntity]
next)

-- | tweet, given a `Tweet` and a `Config` containing necessary data to sign the request.
tweetDataMem :: Tweet -> Config -> IO Int
tweetDataMem :: Tweet -> Config -> IO Int
tweetDataMem Tweet
tweet Config
config = do
    let requestString :: String
requestString = Tweet -> String
urlString Tweet
tweet
    ByteString
bytes <- String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/statuses/update.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString) Config
config
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [TweetEntity] -> String
displayTimelineColor ([TweetEntity] -> String)
-> (ByteString -> [TweetEntity]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle String Void -> [TweetEntity])
-> ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> [TweetEntity]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseErrorBundle String Void -> [TweetEntity]
forall a. HasCallStack => String -> a
error String
"failed to parse tweet") [TweetEntity] -> [TweetEntity]
forall a. a -> a
id (Either (ParseErrorBundle String Void) [TweetEntity]
 -> [TweetEntity])
-> (ByteString
    -> Either (ParseErrorBundle String Void) [TweetEntity])
-> ByteString
-> [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bytes
    Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> (ByteString -> Int) -> ByteString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int TweetEntity Int -> TweetEntity -> Int
forall a s. Getting a s a -> s -> a
view Getting Int TweetEntity Int
Lens' TweetEntity Int
tweetId (TweetEntity -> Int)
-> (ByteString -> TweetEntity) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TweetEntity] -> TweetEntity
forall a. [a] -> a
head ([TweetEntity] -> TweetEntity)
-> (ByteString -> [TweetEntity]) -> ByteString -> TweetEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle String Void -> [TweetEntity])
-> ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> [TweetEntity]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseErrorBundle String Void -> [TweetEntity]
forall a. HasCallStack => String -> a
error String
"failed to parse tweet") [TweetEntity] -> [TweetEntity]
forall a. a -> a
id (Either (ParseErrorBundle String Void) [TweetEntity]
 -> [TweetEntity])
-> (ByteString
    -> Either (ParseErrorBundle String Void) [TweetEntity])
-> ByteString
-> [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> IO Int) -> ByteString -> IO Int
forall a b. (a -> b) -> a -> b
$ ByteString
bytes

-- | tweet, given a `Tweet` and path to credentials. Return id of posted tweet.
tweetData :: Tweet -> FilePath -> IO Int
tweetData :: Tweet -> String -> IO Int
tweetData Tweet
tweet String
filepath = do
    let requestString :: String
requestString = Tweet -> String
urlString Tweet
tweet
    ByteString
bytes <- String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/statuses/update.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString) String
filepath -- FIXME fix the coloration
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [TweetEntity] -> String
displayTimelineColor ([TweetEntity] -> String)
-> (ByteString -> [TweetEntity]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle String Void -> [TweetEntity])
-> ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> [TweetEntity]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseErrorBundle String Void -> [TweetEntity]
forall a. HasCallStack => String -> a
error String
"failed to parse tweet") [TweetEntity] -> [TweetEntity]
forall a. a -> a
id (Either (ParseErrorBundle String Void) [TweetEntity]
 -> [TweetEntity])
-> (ByteString
    -> Either (ParseErrorBundle String Void) [TweetEntity])
-> ByteString
-> [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bytes
    Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> (ByteString -> Int) -> ByteString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int TweetEntity Int -> TweetEntity -> Int
forall a s. Getting a s a -> s -> a
view Getting Int TweetEntity Int
Lens' TweetEntity Int
tweetId (TweetEntity -> Int)
-> (ByteString -> TweetEntity) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TweetEntity] -> TweetEntity
forall a. [a] -> a
head ([TweetEntity] -> TweetEntity)
-> (ByteString -> [TweetEntity]) -> ByteString -> TweetEntity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle String Void -> [TweetEntity])
-> ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> [TweetEntity]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseErrorBundle String Void -> [TweetEntity]
forall a. HasCallStack => String -> a
error String
"failed to parse tweet") [TweetEntity] -> [TweetEntity]
forall a. a -> a
id (Either (ParseErrorBundle String Void) [TweetEntity]
 -> [TweetEntity])
-> (ByteString
    -> Either (ParseErrorBundle String Void) [TweetEntity])
-> ByteString
-> [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> IO Int) -> ByteString -> IO Int
forall a b. (a -> b) -> a -> b
$ ByteString
bytes

-- | Gets user profile with max_id set.
getProfileMax :: String -> Int -> FilePath -> Maybe Int -> IO (Either (ParseErrorBundle String Void) Timeline)
getProfileMax :: String
-> Int
-> String
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getProfileMax = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String -> Int -> String -> Maybe Int -> IO ByteString)
-> String
-> Int
-> String
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall e f a b c d.
(e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
.*** String -> Int -> String -> Maybe Int -> IO ByteString
getProfileRaw

-- | Gets user profile with max_id set.
getProfileMaxMem :: String -> Int -> Config -> Maybe Int -> IO (Either (ParseErrorBundle String Void) Timeline)
getProfileMaxMem :: String
-> Int
-> Config
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getProfileMaxMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String -> Int -> Config -> Maybe Int -> IO ByteString)
-> String
-> Int
-> Config
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall e f a b c d.
(e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
.*** String -> Int -> Config -> Maybe Int -> IO ByteString
getProfileRawMem

-- | Gets user profile with max_id set.
getProfileRaw :: String -> Int -> FilePath -> Maybe Int -> IO BSL.ByteString
getProfileRaw :: String -> Int -> String -> Maybe Int -> IO ByteString
getProfileRaw String
sn Int
count String
filepath Maybe Int
maxId = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/statuses/user_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString) String
filepath
    where requestString :: String
requestString = case Maybe Int
maxId of {
        (Just Int
i) -> String
"?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&max_id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i ;
        Maybe Int
Nothing -> String
"?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count }

-- | Gets user profile with max_id set
getProfileRawMem :: String -> Int -> Config -> Maybe Int -> IO BSL.ByteString
getProfileRawMem :: String -> Int -> Config -> Maybe Int -> IO ByteString
getProfileRawMem String
sn Int
count Config
config Maybe Int
maxId = String -> Config -> IO ByteString
getRequestMem (String
"https://api.twitter.com/1.1/statuses/user_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString) Config
config
    where requestString :: String
requestString = case Maybe Int
maxId of {
        (Just Int
i) -> String
"?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&max_id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i ;
        Maybe Int
Nothing -> String
"?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count }

-- | Get mentions and parse response as a list of tweets
mentions :: Int -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
mentions :: Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
mentions = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Int -> String -> IO ByteString)
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> String -> IO ByteString
mentionsRaw

-- | Get mentions and parse response as a list of tweets
mentionsMem :: Int -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
mentionsMem :: Int
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
mentionsMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Int -> Config -> IO ByteString)
-> Int
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> Config -> IO ByteString
mentionsRawMem

searchRaw :: String -> FilePath -> IO BSL.ByteString
searchRaw :: String -> String -> IO ByteString
searchRaw String
str = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/search/tweets.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str)

searchMentionsRaw :: Maybe Int -- ^ Max ID
                  -> String -- ^ Username
                  -> FilePath
                  -> IO BSL.ByteString
searchMentionsRaw :: Maybe Int -> String -> String -> IO ByteString
searchMentionsRaw Maybe Int
maxid String
uname = String -> String -> IO ByteString
searchRaw (String
"?q=to%3A" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
uname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
maxidUrl)
    where maxidUrl :: String
maxidUrl = case Maybe Int
maxid of
            Just Int
id' -> String
"&max_id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
id'
            Maybe Int
Nothing  -> String
""

searchRepliesRaw :: Maybe Int -- ^ Max ID
                 -> String -- ^ Username
                 -> Int -- ^ Tweet ID
                 -> FilePath
                 -> IO BSL.ByteString
searchRepliesRaw :: Maybe Int -> String -> Int -> String -> IO ByteString
searchRepliesRaw Maybe Int
maxid String
uname Int
twid = String -> String -> IO ByteString
searchRaw (String
"?q=to%3A" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
uname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&since_id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
twid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
maxidUrl)
    where maxidUrl :: String
maxidUrl = case Maybe Int
maxid of
            Just Int
id' -> String
"&max_id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
id'
            Maybe Int
Nothing  -> String
""

loopMentions :: Maybe Int -> Maybe Int -> S.Set String -> String -> FilePath -> IO ()
loopMentions :: Maybe Int -> Maybe Int -> Set String -> String -> String -> IO ()
loopMentions Maybe Int
pastMax Maybe Int
maxid Set String
alreadyMuted String
uname String
fp =
    if Maybe Int
maxid Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
pastMax
        then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else do
            Either (ParseErrorBundle String Void) [TweetEntity]
next <- Maybe Int
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
searchMentions Maybe Int
maxid String
uname String
fp
            case Either (ParseErrorBundle String Void) [TweetEntity]
next of
                Right [] -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Left{} -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Right [TweetEntity]
tws -> do
                    let newMax :: Int
newMax = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (TweetEntity -> Int
_tweetId (TweetEntity -> Int) -> [TweetEntity] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TweetEntity]
tws)
                    let toMute :: [String]
toMute = [ String
tw | String
tw <- [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd (TweetEntity -> String
_screenName (TweetEntity -> String) -> [TweetEntity] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TweetEntity]
tws), String
tw String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set String
alreadyMuted ]
                    let modAlready :: Set String -> Set String
modAlready = [Set String -> Set String] -> Set String -> Set String
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread [ String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
S.insert String
k | String
k <- [String]
toMute ]
                    String -> IO ()
putStrLn String
"Muted:"
                    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\String
u -> String -> String -> IO ()
mute String
u String
fp IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
putStrLn String
u) [String]
toMute
                    Maybe Int -> Maybe Int -> Set String -> String -> String -> IO ()
loopMentions Maybe Int
maxid (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newMax) (Set String -> Set String
modAlready Set String
alreadyMuted) String
uname String
fp

muteMentions :: String -- ^ Screen name
             -> FilePath
             -> IO ()
muteMentions :: String -> String -> IO ()
muteMentions = Maybe Int -> Maybe Int -> Set String -> String -> String -> IO ()
loopMentions (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) Maybe Int
forall a. Maybe a
Nothing Set String
forall a. Monoid a => a
mempty

loopReplies :: Maybe Int -> Maybe Int -> String -> Int -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
loopReplies :: Maybe Int
-> Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
loopReplies Maybe Int
pastMax Maybe Int
maxid String
uname Int
twid String
fp =
    if Maybe Int
maxid Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
pastMax
        then Either (ParseErrorBundle String Void) [TweetEntity]
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TweetEntity]
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall a b. b -> Either a b
Right [])
        else do
            Either (ParseErrorBundle String Void) [TweetEntity]
next <- Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
searchReplies Maybe Int
maxid String
uname Int
twid String
fp
            case Either (ParseErrorBundle String Void) [TweetEntity]
next of
                Right [] -> Either (ParseErrorBundle String Void) [TweetEntity]
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TweetEntity]
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall a b. b -> Either a b
Right [])
                Left ParseErrorBundle String Void
x -> Either (ParseErrorBundle String Void) [TweetEntity]
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseErrorBundle String Void
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall a b. a -> Either a b
Left ParseErrorBundle String Void
x)
                Right [TweetEntity]
tws -> let newMax :: Int
newMax = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (TweetEntity -> Int
_tweetId (TweetEntity -> Int) -> [TweetEntity] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TweetEntity]
tws)
                        in ([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([TweetEntity]
tws [TweetEntity] -> [TweetEntity] -> [TweetEntity]
forall a. [a] -> [a] -> [a]
++) (Either (ParseErrorBundle String Void) [TweetEntity]
 -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
-> Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
loopReplies Maybe Int
maxid (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newMax) String
uname Int
twid String
fp

searchMentions :: Maybe Int -> String -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
searchMentions :: Maybe Int
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
searchMentions = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Maybe Int -> String -> String -> IO ByteString)
-> Maybe Int
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall d e a b c.
(d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e
.** Maybe Int -> String -> String -> IO ByteString
searchMentionsRaw

searchReplies :: Maybe Int -> String -> Int -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
searchReplies :: Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
searchReplies = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Maybe Int -> String -> Int -> String -> IO ByteString)
-> Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall e f a b c d.
(e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f
.*** Maybe Int -> String -> Int -> String -> IO ByteString
searchRepliesRaw

getReplies :: String -- ^ Screen name
           -> Int -- ^ Tweet
           -> FilePath
           -> IO (Either (ParseErrorBundle String Void) Timeline)
getReplies :: String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getReplies String
str Int
twid = (Either (ParseErrorBundle String Void) [TweetEntity]
 -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TweetEntity -> Bool) -> [TweetEntity] -> [TweetEntity]
forall a. (a -> Bool) -> [a] -> [a]
filter TweetEntity -> Bool
p)) (IO (Either (ParseErrorBundle String Void) [TweetEntity])
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String
    -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int
-> Maybe Int
-> String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
loopReplies (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) Maybe Int
forall a. Maybe a
Nothing String
str Int
twid
    where p :: TweetEntity -> Bool
p TweetEntity
entity = TweetEntity -> Maybe Int
_replyTo TweetEntity
entity Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
twid

muteRepliers :: String
             -> Int
             -> FilePath
             -> IO [String]
muteRepliers :: String -> Int -> String -> IO [String]
muteRepliers String
str Int
twid String
fp = do
    Either (ParseErrorBundle String Void) [TweetEntity]
us <- String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getReplies String
str Int
twid String
fp
    case Either (ParseErrorBundle String Void) [TweetEntity]
us of
        Left{} -> [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        -- TODO: add a delay so I don't get rate limited?
        Right [TweetEntity]
xs -> let toMute :: [String]
toMute = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd (TweetEntity -> String
_screenName (TweetEntity -> String) -> [TweetEntity] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TweetEntity]
xs) in (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
u -> String -> String -> IO ()
mute String
u String
fp IO () -> String -> IO String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String
u) [String]
toMute

-- | Gets mentions
mentionsRaw :: Int -> FilePath -> IO BSL.ByteString
mentionsRaw :: Int -> String -> IO ByteString
mentionsRaw Int
count = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/statuses/mentions_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString)
    where requestString :: String
requestString = String
"?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count

-- | Gets mentions
mentionsRawMem :: Int -> Config -> IO BSL.ByteString
mentionsRawMem :: Int -> Config -> IO ByteString
mentionsRawMem Int
count = String -> Config -> IO ByteString
getRequestMem (String
"https://api.twitter.com/1.1/statuses/mentions_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString)
    where requestString :: String
requestString = String
"?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count

-- | Get user profile given screen name and how many tweets to return
getProfile :: String -> Int -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
getProfile :: String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getProfile String
sn Int
count String
filepath = String
-> Int
-> String
-> Maybe Int
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getProfileMax String
sn Int
count String
filepath Maybe Int
forall a. Maybe a
Nothing

-- | Mute a user given their screen name
mute :: String -> FilePath -> IO ()
mute :: String -> String -> IO ()
mute = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
muteUserRaw

-- | Mute a user given their screen name
muteMem :: String -> Config -> IO ()
muteMem :: String -> Config -> IO ()
muteMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
muteUserRawMem

-- | Unmute a user given their screen name
unmute :: String -> FilePath -> IO ()
unmute :: String -> String -> IO ()
unmute = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
unmuteUserRaw

-- | Unmute a user given their screen name
unmuteMem :: String -> Config -> IO ()
unmuteMem :: String -> Config -> IO ()
unmuteMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
unmuteUserRawMem

-- | Mute a user given their screen name
muteUserRaw :: String -> FilePath -> IO BSL.ByteString
muteUserRaw :: String -> String -> IO ByteString
muteUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Mute a user given their screen name
muteUserRawMem :: String -> Config -> IO BSL.ByteString
muteUserRawMem :: String -> Config -> IO ByteString
muteUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/mutes/users/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Unmute a user given their screen name
unmuteUserRaw :: String -> FilePath -> IO BSL.ByteString
unmuteUserRaw :: String -> String -> IO ByteString
unmuteUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Unmute a user given their screen name
unmuteUserRawMem :: String -> Config -> IO BSL.ByteString
unmuteUserRawMem :: String -> Config -> IO ByteString
unmuteUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/mutes/users/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Get user's DMs.
getDMsRaw :: Show p => p -> FilePath -> IO BSL.ByteString
getDMsRaw :: p -> String -> IO ByteString
getDMsRaw p
count = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/direct_messages.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString)
    where requestString :: String
requestString = String
"?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
count

-- | Get a user's favorites
getFavorites :: Int -> String -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
getFavorites :: Int
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getFavorites Int
count = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TweetEntity] -> [TweetEntity])
-> Either (ParseErrorBundle String Void) [TweetEntity]
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [TweetEntity] -> [TweetEntity]
forall a. Int -> [a] -> [a]
take Int
count) (Either (ParseErrorBundle String Void) [TweetEntity]
 -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString
    -> Either (ParseErrorBundle String Void) [TweetEntity])
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String -> String -> IO ByteString)
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* String -> String -> IO ByteString
favoriteTweetListRaw

-- | Get a timeline
getTimeline :: Int -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
getTimeline :: Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getTimeline = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Int -> String -> IO ByteString)
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> String -> IO ByteString
getTimelineRaw

-- | Get a timeline
getTimelineMem :: Int -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
getTimelineMem :: Int
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
getTimelineMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Int -> Config -> IO ByteString)
-> Int
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> Config -> IO ByteString
getTimelineRawMem

-- | Get a user's timeline and return response as a bytestring
getTimelineRaw :: Int -> FilePath -> IO BSL.ByteString
getTimelineRaw :: Int -> String -> IO ByteString
getTimelineRaw Int
count = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/statuses/home_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString)
    where requestString :: String
requestString = String
"?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count

-- | Get a user's timeline and return response as a bytestring
getTimelineRawMem :: Int -> Config -> IO BSL.ByteString
getTimelineRawMem :: Int -> Config -> IO ByteString
getTimelineRawMem Int
count = String -> Config -> IO ByteString
getRequestMem (String
"https://api.twitter.com/1.1/statuses/home_timeline.json" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requestString)
    where requestString :: String
requestString = String
"?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count

-- | Delete a tweet given its id
deleteTweet :: Integer -> FilePath -> IO ()
deleteTweet :: Integer -> String -> IO ()
deleteTweet = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> IO ByteString
deleteTweetRaw

-- | Delete a tweet given its id
deleteTweetMem :: Integer -> Config -> IO ()
deleteTweetMem :: Integer -> Config -> IO ()
deleteTweetMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Config -> IO ByteString
deleteTweetRawMem

-- | Get response, i.e. the tweet deleted
deleteTweetResponse :: Integer -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
deleteTweetResponse :: Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
deleteTweetResponse = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> String -> IO ByteString
deleteTweetRaw

-- | Get response, i.e. the tweet deleted
deleteTweetResponseMem :: Integer -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
deleteTweetResponseMem :: Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
deleteTweetResponseMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> Config -> IO ByteString
deleteTweetRawMem

-- | Favorite a tweet given its id
favoriteTweet :: Integer -> FilePath -> IO ()
favoriteTweet :: Integer -> String -> IO ()
favoriteTweet = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> IO ByteString
favoriteTweetRaw

-- | Favorite a tweet given its id
favoriteTweetMem :: Integer -> Config -> IO ()
favoriteTweetMem :: Integer -> Config -> IO ()
favoriteTweetMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Config -> IO ByteString
favoriteTweetRawMem

-- | Favorite a tweet and returned the (parsed) response
favoriteTweetList :: String -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
favoriteTweetList :: String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
favoriteTweetList = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String -> String -> IO ByteString)
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* String -> String -> IO ByteString
favoriteTweetListRaw

-- | Favorite a tweet and returned the (parsed) response
favoriteTweetListMem :: String -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
favoriteTweetListMem :: String
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
favoriteTweetListMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (String -> Config -> IO ByteString)
-> String
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* String -> Config -> IO ByteString
favoriteTweetListRawMem

-- | Favorite a tweet and returned the (parsed) response
favoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
favoriteTweetResponse :: Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
favoriteTweetResponse = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> String -> IO ByteString
favoriteTweetRaw

-- | Unfavorite a tweet given its id
unfavoriteTweet :: Integer -> FilePath -> IO ()
unfavoriteTweet :: Integer -> String -> IO ()
unfavoriteTweet = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> IO ByteString
unfavoriteTweetRaw

-- | Unfavorite a tweet given its id
unfavoriteTweetMem :: Integer -> Config -> IO ()
unfavoriteTweetMem :: Integer -> Config -> IO ()
unfavoriteTweetMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Config -> IO ByteString
unfavoriteTweetRawMem

-- | Unfavorite a tweet and returned the (parsed) response
unfavoriteTweetResponse :: Integer -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
unfavoriteTweetResponse :: Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
unfavoriteTweetResponse = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> String -> IO ByteString
unfavoriteTweetRaw

-- | Unfavorite a tweet and returned the (parsed) response
unfavoriteTweetResponseMem :: Integer -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
unfavoriteTweetResponseMem :: Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
unfavoriteTweetResponseMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> Config -> IO ByteString
unfavoriteTweetRawMem

-- | Unretweet a tweet given its id
unretweetTweet :: Integer -> FilePath -> IO ()
unretweetTweet :: Integer -> String -> IO ()
unretweetTweet = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> IO ByteString
unretweetTweetRaw

-- | Unretweet a tweet given its id
unretweetTweetMem :: Integer -> Config -> IO ()
unretweetTweetMem :: Integer -> Config -> IO ()
unretweetTweetMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Config -> IO ByteString
unretweetTweetRawMem

-- | Unretweet a tweet and returned the (parsed) response
unretweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
unretweetTweetResponse :: Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
unretweetTweetResponse = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> String -> IO ByteString
unretweetTweetRaw

-- | Unretweet a tweet and returned the (parsed) response
unretweetTweetResponseMem :: Integer -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
unretweetTweetResponseMem :: Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
unretweetTweetResponseMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> Config -> IO ByteString
unretweetTweetRawMem

-- | Unfollow a user given their screen name
unfollow :: String -> FilePath -> IO ()
unfollow :: String -> String -> IO ()
unfollow = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
unfollowUserRaw

-- | Unfollow a user given their screen name
unfollowMem :: String -> Config -> IO ()
unfollowMem :: String -> Config -> IO ()
unfollowMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
unfollowUserRawMem

-- | Follow a user given their screen name
follow :: String -> FilePath -> IO ()
follow :: String -> String -> IO ()
follow = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
followUserRaw

-- | Follow a user given their screen name
followMem :: String -> Config -> IO ()
followMem :: String -> Config -> IO ()
followMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
followUserRawMem

-- | Block a user given their screen name
block :: String -> FilePath -> IO ()
block :: String -> String -> IO ()
block = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
blockUserRaw

-- | Block a user given their screen name
blockMem :: String -> Config -> IO ()
blockMem :: String -> Config -> IO ()
blockMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
blockUserRawMem

-- | Unblock a user given their screen name
unblock :: String -> FilePath -> IO ()
unblock :: String -> String -> IO ()
unblock = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (String -> String -> IO ByteString) -> String -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ByteString
unblockUserRaw

-- | Unblock a user given their screen name
unblockMem :: String -> Config -> IO ()
unblockMem :: String -> Config -> IO ()
unblockMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (String -> Config -> IO ByteString) -> String -> Config -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Config -> IO ByteString
unblockUserRawMem

-- | Retweet a tweet given its id
retweetTweet :: Integer -> FilePath -> IO ()
retweetTweet :: Integer -> String -> IO ()
retweetTweet = (IO ByteString -> IO ())
-> (String -> IO ByteString) -> String -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> IO ByteString) -> String -> IO ())
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> IO ByteString
retweetTweetRaw

-- | Retweet a tweet given its id
retweetTweetMem :: Integer -> Config -> IO ()
retweetTweetMem :: Integer -> Config -> IO ()
retweetTweetMem = (IO ByteString -> IO ())
-> (Config -> IO ByteString) -> Config -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO ByteString -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Config -> IO ByteString) -> Config -> IO ())
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Config -> IO ByteString
retweetTweetRawMem

-- | Retweet a tweet and returned the (parsed) response
retweetTweetResponse :: Integer -> FilePath -> IO (Either (ParseErrorBundle String Void) Timeline)
retweetTweetResponse :: Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
retweetTweetResponse = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> String -> IO ByteString)
-> Integer
-> String
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> String -> IO ByteString
retweetTweetRaw

-- | Retweet a tweet and returned the (parsed) response
retweetTweetResponseMem :: Integer -> Config -> IO (Either (ParseErrorBundle String Void) Timeline)
retweetTweetResponseMem :: Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
retweetTweetResponseMem = (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> IO ByteString
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity]
getTweets (ByteString -> Either (ParseErrorBundle String Void) [TweetEntity])
-> (ByteString -> ByteString)
-> ByteString
-> Either (ParseErrorBundle String Void) [TweetEntity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict) (IO ByteString
 -> IO (Either (ParseErrorBundle String Void) [TweetEntity]))
-> (Integer -> Config -> IO ByteString)
-> Integer
-> Config
-> IO (Either (ParseErrorBundle String Void) [TweetEntity])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Integer -> Config -> IO ByteString
retweetTweetRawMem

-- | Get a lisr of favorited tweets by screen name; return bytestring response
favoriteTweetListRaw :: String -> FilePath -> IO BSL.ByteString
favoriteTweetListRaw :: String -> String -> IO ByteString
favoriteTweetListRaw String
sn = String -> String -> IO ByteString
getRequest (String
"https://api.twitter.com/1.1/favorites/list.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Get a lisr of favorited tweets by screen name; return bytestring response
favoriteTweetListRawMem :: String -> Config -> IO BSL.ByteString
favoriteTweetListRawMem :: String -> Config -> IO ByteString
favoriteTweetListRawMem String
sn = String -> Config -> IO ByteString
getRequestMem (String
"https://api.twitter.com/1.1/favorites/list.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Favorite a tweet given its id; return bytestring response
favoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString
favoriteTweetRaw :: Integer -> String -> IO ByteString
favoriteTweetRaw Integer
idNum = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/favorites/create.json?id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum)

-- | Favorite a tweet given its idNum; return bytestring response
favoriteTweetRawMem :: Integer -> Config -> IO BSL.ByteString
favoriteTweetRawMem :: Integer -> Config -> IO ByteString
favoriteTweetRawMem Integer
idNum = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/favorites/create.json?id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum)

-- | Retweet a tweet given its idNum; return bytestring response
retweetTweetRaw :: Integer -> FilePath -> IO BSL.ByteString
retweetTweetRaw :: Integer -> String -> IO ByteString
retweetTweetRaw Integer
idNum = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/statuses/retweet/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")

-- | Retweet a tweet given its idNum; return bytestring response
retweetTweetRawMem :: Integer -> Config -> IO BSL.ByteString
retweetTweetRawMem :: Integer -> Config -> IO ByteString
retweetTweetRawMem Integer
idNum = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/statuses/retweet/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")

-- | Send a DM given text, screen name of recipient.
sendDMRaw :: String -> String -> FilePath -> IO BSL.ByteString
sendDMRaw :: String -> String -> String -> IO ByteString
sendDMRaw String
txt String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/direct_messages/new.json?text=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
encoded String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"&screen_name" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")
    where encoded :: String
encoded = String -> String
strEncode String
txt

-- | Get DMs, return bytestring of response
getDMs :: Int -> FilePath -> IO BSL.ByteString
getDMs :: Int -> String -> IO ByteString
getDMs Int
count = String -> String -> IO ByteString
getRequest (String
"https://dev.twitter.com/rest/reference/get/direct_messages.json?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count)

-- | Get DMs, return bytestring of response
getDMMem :: Int -> Config -> IO BSL.ByteString
getDMMem :: Int -> Config -> IO ByteString
getDMMem Int
count = String -> Config -> IO ByteString
getRequestMem (String
"https://dev.twitter.com/rest/reference/get/direct_messages.json?count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count)

-- | Follow a user given their screen name
followUserRaw :: String -> FilePath -> IO BSL.ByteString
followUserRaw :: String -> String -> IO ByteString
followUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/friendships/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Follow a user given their screen name
followUserRawMem :: String -> Config -> IO BSL.ByteString
followUserRawMem :: String -> Config -> IO ByteString
followUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/friendships/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Block a user given their screen name
blockUserRaw :: String -> FilePath -> IO BSL.ByteString
blockUserRaw :: String -> String -> IO ByteString
blockUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/blocks/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Block a user given their screen name
blockUserRawMem :: String -> Config -> IO BSL.ByteString
blockUserRawMem :: String -> Config -> IO ByteString
blockUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/blocks/create.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Unblock a user given their screen name
unblockUserRaw :: String -> FilePath -> IO BSL.ByteString
unblockUserRaw :: String -> String -> IO ByteString
unblockUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Unblock a user given their screen name
unblockUserRawMem :: String -> Config -> IO BSL.ByteString
unblockUserRawMem :: String -> Config -> IO ByteString
unblockUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/blocks/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Follow a user given their screen name
unfollowUserRaw :: String -> FilePath -> IO BSL.ByteString
unfollowUserRaw :: String -> String -> IO ByteString
unfollowUserRaw String
sn = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Follow a user given their screen name
unfollowUserRawMem :: String -> Config -> IO BSL.ByteString
unfollowUserRawMem :: String -> Config -> IO ByteString
unfollowUserRawMem String
sn = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/friendships/destroy.json?screen_name=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sn)

-- | Unretweet a tweet given its id; return bytestring response
unretweetTweetRaw :: Integer -> FilePath -> IO BSL.ByteString
unretweetTweetRaw :: Integer -> String -> IO ByteString
unretweetTweetRaw Integer
idNum = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/statuses/unretweet/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")

-- | Unretweet a tweet given its idNum; return bytestring response
unretweetTweetRawMem :: Integer -> Config -> IO BSL.ByteString
unretweetTweetRawMem :: Integer -> Config -> IO ByteString
unretweetTweetRawMem Integer
idNum = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/statuses/unretweet/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")

-- | Unfavorite a tweet given its idNum; return bytestring response
unfavoriteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString
unfavoriteTweetRaw :: Integer -> String -> IO ByteString
unfavoriteTweetRaw Integer
idNum = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/favorites/destroy.json?id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum)

-- | Unfavorite a tweet given its idNum; return bytestring response
unfavoriteTweetRawMem :: Integer -> Config -> IO BSL.ByteString
unfavoriteTweetRawMem :: Integer -> Config -> IO ByteString
unfavoriteTweetRawMem Integer
idNum = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/favorites/destroy.json?id=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum)

-- | Delete a tweet given its idNum; return bytestring response
deleteTweetRaw :: Integer -> FilePath -> IO BSL.ByteString
deleteTweetRaw :: Integer -> String -> IO ByteString
deleteTweetRaw Integer
idNum = String -> String -> IO ByteString
postRequest (String
"https://api.twitter.com/1.1/statuses/destroy/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")

-- | Delete a tweet given its idNum; return bytestring response
deleteTweetRawMem :: Integer -> Config -> IO BSL.ByteString
deleteTweetRawMem :: Integer -> Config -> IO ByteString
deleteTweetRawMem Integer
idNum = String -> Config -> IO ByteString
postRequestMem (String
"https://api.twitter.com/1.1/statuses/destroy/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json")