module Web.Tweet
(
basicTweet
, tweetData
, thread
, module Web.Tweet.Types
, signRequest
, urlString
, getTimeline
, showTimeline
, getProfile
, showProfile
, showBest
, getDMs
, showDMs
, getRaw
) where
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types.Status (statusCode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Char
import Web.Tweet.Types
import Web.Tweet.Utils
import Control.Monad
import Data.List.Split (chunksOf)
import Data.Maybe
import Control.Lens
import Control.Lens.Tuple
import Web.Authenticate.OAuth
import Web.Tweet.Sign
import Data.List.Utils
import Text.Megaparsec.Error
thread :: String -> [String] -> Maybe Int -> Int -> FilePath -> IO ()
thread contents hs idNum num filepath = do
let handleStr = concatMap (((++) " ") . ((++) "@")) hs
let content = (take num) . (chunksOf (140(length handleStr))) $ contents
case idNum of
(Just i) -> thread' content hs idNum num filepath
Nothing -> case content of
[] -> pure ()
[x] -> void $ basicTweet x filepath
y@(x:xs) -> thread' y hs (Just 0) num filepath
thread' :: [String] -> [String] -> Maybe Int -> Int -> FilePath -> IO ()
thread' content hs idNum num filepath = do
let f = \str i -> tweetData (Tweet { _status = str, _trimUser = True, _handles = hs, _replyID = if i == 0 then Nothing else Just i }) filepath
let initial = f (head content)
last <- foldr ((>=>) . f) initial (content) $ fromMaybe 0 idNum
deleteTweet last filepath
reply :: String -> [String] -> Maybe Int -> FilePath -> IO ()
reply contents hs idNum = thread contents hs idNum 1
basicTweet :: String -> FilePath -> IO Int
basicTweet contents = tweetData (mkTweet contents)
mkTweet :: String -> Tweet
mkTweet contents = over (status) (const (contents)) def
tweetData :: Tweet -> FilePath -> IO Int
tweetData tweet filepath = do
let requestString = urlString tweet
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/update.json" ++ requestString)
request <- signRequest filepath $ initialRequest { method = "POST" }
responseInt request manager
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)
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
getTweets . BSL.unpack <$> responseBS request manager
getProfile :: String -> Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
getProfile screenName count filepath = getProfileMax screenName count filepath Nothing
showDMs count color filepath = showTweets color <$> getDMs count filepath
showProfile :: String -> Int -> Bool -> FilePath -> IO String
showProfile screenName count color filepath = showTweets color <$> getProfile screenName count filepath
showBest :: String -> Bool -> FilePath -> IO String
showBest screenName color filepath = showTweets color . (fmap (take 13 . hits)) <$> getProfile screenName 3200 filepath
showTimeline :: Int -> Bool -> FilePath -> IO String
showTimeline count color filepath = showTweets color <$> getTimeline count filepath
showTweets :: Bool -> Either (ParseError Char Dec) Timeline -> String
showTweets color = (either show id) . (fmap (if color then displayTimelineColor else displayTimeline))
getDMs count filepath = do
let requestString = "?count=" ++ (show count)
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest ("https://api.twitter.com/1.1/direct_messages.json" ++ requestString)
request <- signRequest filepath $ initialRequest { method = "GET" }
getTweets . BSL.unpack <$> responseBS request manager
getTimeline :: Int -> FilePath -> IO (Either (ParseError Char Dec) Timeline)
getTimeline count filepath = do
let requestString = "?count=" ++ (show count)
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/home_timeline.json" ++ requestString)
request <- signRequest filepath $ initialRequest { method = "GET" }
getTweets . BSL.unpack <$> responseBS request manager
deleteTweet id filepath = do
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest ("https://api.twitter.com/1.1/statuses/destroy/" ++ (show id) ++ ".json")
request <- signRequest filepath $ initialRequest { method = "POST" }
void $ responseBS request manager
responseBS :: Request -> Manager -> IO BSL.ByteString
responseBS request manager = do
response <- httpLbs request manager
let code = statusCode $ responseStatus response
putStr $ if (code == 200) then "" else "failed :(\n error code: " ++ (show code) ++ "\n"
pure . responseBody $ response
responseInt :: Request -> Manager -> IO Int
responseInt request manager = do
response <- httpLbs request manager
let code = statusCode $ responseStatus response
putStrLn $ if (code == 200) then "POST succesful!" else "failed :(\n error code: " ++ (show code)
return $ (read . (takeWhile (/=',')) . (drop 52)) (BSL.unpack $ responseBody response)
urlString :: Tweet -> String
urlString tweet = concat [ "?status="
, BS.unpack (tweetEncode tweet)
, "&trim_user="
, map toLower (show trim)
, (if isJust (_replyID tweet) then "&in_reply_to_status_id=" else "")
, reply ]
where trim = _trimUser tweet
reply = fromMaybe "" (show <$> _replyID tweet)
tweetEncode :: Tweet -> BS.ByteString
tweetEncode tweet = paramEncode . encodeUtf8 $ handleStr `T.append` content
where content = T.pack . _status $ tweet
handleStr = T.pack $ concatMap ((++ " ") . ((++) "@")) hs
hs = _handles tweet