-- | Various utilities to tweet using the twitter api
--
-- Make sure you have a file credentials file (default the executable looks for is @$HOME/.cred.toml@) with the following info:
--
-- @
--
-- api-key = "API_KEY"
--
-- api-sec = "API_SECRET"
--
-- tok = "OAUTH_TOKEN"
--
-- tok-sec = "TOKEN_SECRET"
--
-- @

module Web.Tweet
    (
    -- * Functions to tweet
      basicTweet
    , thread
    , reply
    -- * Data type for a tweet
    , module Web.Tweet.Types
    -- * Various API calls
    , module Web.Tweet.API
    , module Web.Tweet.API.Internal
    -- * Functions to sign API requests
    , signRequest
    , oAuthMem
    , credentialMem
    -- * Functions to generate a URL string from a `Tweet`
    , urlString
    -- * Timeline filters
    , filterReplies
    , filterRTs
    , filterQuotes
    -- * Helper function to print a bird
    , bird
    ) where

import           Control.Monad
import           Data.List.Split        (chunksOf)
import           Data.Maybe
import           Lens.Micro
import           Web.Tweet.API
import           Web.Tweet.API.Internal
import           Web.Tweet.Sign
import           Web.Tweet.Types
import           Web.Tweet.Utils
import           Web.Tweet.Utils.API

-- | Tweet a string given a path to credentials; return the id of the status.
--
-- > basicTweet "On the airplane." ".cred.toml"
basicTweet :: String -> FilePath -> IO Int
basicTweet :: String -> String -> IO Int
basicTweet String
contents = Tweet -> String -> IO Int
tweetData (String -> Tweet
mkTweet String
contents)

-- | 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.
--
-- > thread "Hi I'm back in New York!" ["friend1","friend2"] Nothing 1 ".cred"
thread :: String -> [String] -> Maybe Int -> Int -> FilePath -> IO ()
thread :: String -> [String] -> Maybe Int -> Int -> String -> IO ()
thread String
contents [String]
hs Maybe Int
idNum Int
num String
filepath = do
    let handleStr :: String
handleStr = (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
"@") [String]
hs
    let content :: [String]
content = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
num ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf (Int
280Int -> Int -> Int
forall a. Num a => a -> a -> a
-String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
handleStr) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
contents
    case Maybe Int
idNum of
        (Just Int
_) -> [String] -> [String] -> Maybe Int -> String -> IO ()
thread' [String]
content [String]
hs Maybe Int
idNum String
filepath
        Maybe Int
Nothing -> case [String]
content of
            []      -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            [String
x]     -> IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO Int
basicTweet String
x String
filepath
            y :: [String]
y@(String
_:[String]
_) -> [String] -> [String] -> Maybe Int -> String -> IO ()
thread' [String]
y [String]
hs (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) String
filepath

-- | Helper function to make `thread` easier to write.
thread' :: [String] -> [String] -> Maybe Int -> FilePath -> IO ()
thread' :: [String] -> [String] -> Maybe Int -> String -> IO ()
thread' [String]
content [String]
hs Maybe Int
idNum String
filepath = do
    let f :: String -> Int -> IO Int
f String
str Int
i = Tweet -> String -> IO Int
tweetData Tweet :: String -> [String] -> Maybe Int -> Tweet
Tweet { _status :: String
_status = String
str, _handles :: [String]
_handles = [String]
hs, _replyID :: Maybe Int
_replyID = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i } String
filepath
    let initial :: Int -> IO Int
initial = String -> Int -> IO Int
f ([String] -> String
forall a. [a] -> a
head [String]
content)
    Int
lastTweet <- (String -> (Int -> IO Int) -> Int -> IO Int)
-> (Int -> IO Int) -> [String] -> Int -> IO Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> IO Int) -> (Int -> IO Int) -> Int -> IO Int
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) ((Int -> IO Int) -> (Int -> IO Int) -> Int -> IO Int)
-> (String -> Int -> IO Int)
-> String
-> (Int -> IO Int)
-> Int
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> IO Int
f) Int -> IO Int
initial [String]
content (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
idNum
    Integer -> String -> IO ()
deleteTweet (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lastTweet) String
filepath

-- | Reply with a single tweet. Works the same as `thread` but doesn't take the fourth argument.
--
-- > reply "Idk what that means" ["friend1"] (Just 189943500) ".cred"
reply :: String -> [String] -> Maybe Int -> FilePath -> IO ()
reply :: String -> [String] -> Maybe Int -> String -> IO ()
reply String
contents [String]
hs Maybe Int
idNum = String -> [String] -> Maybe Int -> Int -> String -> IO ()
thread String
contents [String]
hs Maybe Int
idNum Int
1

-- | Make a `Tweet` with only the contents.
mkTweet :: String -> Tweet
mkTweet :: String -> Tweet
mkTweet String
contents = ASetter Tweet Tweet String String
-> (String -> String) -> Tweet -> Tweet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Tweet Tweet String String
Lens' Tweet String
status (String -> String -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
contents) Tweet
pricklyTweet