{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Web.Twitter.Conduit.Status
       (
       -- * Timelines
         StatusesMentionsTimeline
       , mentionsTimeline
       , StatusesUserTimeline
       , userTimeline
       , StatusesHomeTimeline
       , homeTimeline
       , StatusesRetweetsOfMe
       , retweetsOfMe
       -- * Tweets
       , StatusesRetweetsId
       , retweetsId
       , StatusesShowId
       , showId
       , StatusesDestroyId
       , destroyId
       , StatusesUpdate
       , update
       , StatusesRetweetId
       , retweetId
       , MediaData (..)
       , StatusesUpdateWithMedia
       , updateWithMedia
       -- , oembed
       -- , retweetersIds
       , StatusesLookup
       , lookup
       ) where

import Prelude hiding ( lookup )
import Web.Twitter.Conduit.Base
import Web.Twitter.Conduit.Request
import Web.Twitter.Conduit.Request.Internal
import Web.Twitter.Conduit.Parameters
import Web.Twitter.Types

import qualified Data.Text as T
import Network.HTTP.Client.MultipartFormData
import Data.Default

-- $setup
-- >>> :set -XOverloadedStrings -XOverloadedLabels
-- >>> import Control.Lens

-- * Timelines

-- | Returns query data asks the most recent mentions for the authenticating user.
--
-- You can perform a query using 'call':
--
-- @
-- res <- 'call' 'mentionsTimeline'
-- @
--
-- >>> mentionsTimeline
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/mentions_timeline.json" []
mentionsTimeline :: APIRequest StatusesMentionsTimeline [Status]
mentionsTimeline :: APIRequest StatusesMentionsTimeline [Status]
mentionsTimeline = Method
-> String
-> APIQuery
-> APIRequest StatusesMentionsTimeline [Status]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" (String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/mentions_timeline.json") APIQuery
forall a. Default a => a
def
type StatusesMentionsTimeline = '[
      "count" ':= Integer
    , "since_id" ':= Integer
    , "max_id" ':= Integer
    , "trim_user" ':= Bool
    , "contributor_details" ':= Bool
    , "include_entities" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns query data asks a collection of the most recent Tweets posted by the user indicated by the screen_name or user_id parameters.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' $ 'userTimeline' ('ScreenNameParam' \"thimura\")
-- @
--
-- >>> userTimeline (ScreenNameParam "thimura")
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/user_timeline.json" [("screen_name","thimura")]
-- >>> userTimeline (ScreenNameParam "thimura") & #include_rts ?~ True & #count ?~ 200
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/user_timeline.json" [("count","200"),("include_rts","true"),("screen_name","thimura")]
userTimeline :: UserParam -> APIRequest StatusesUserTimeline [Status]
userTimeline :: UserParam -> APIRequest StatusesUserTimeline [Status]
userTimeline UserParam
q = Method
-> String -> APIQuery -> APIRequest StatusesUserTimeline [Status]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" (String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/user_timeline.json") (UserParam -> APIQuery
mkUserParam UserParam
q)
type StatusesUserTimeline = '[
      "count" ':= Integer
    , "since_id" ':= Integer
    , "max_id" ':= Integer
    , "trim_user" ':= Bool
    , "exclude_replies" ':= Bool
    , "contributor_details" ':= Bool
    , "include_rts" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns query data asks a collection of the most recentTweets and retweets posted by the authenticating user and the users they follow.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' 'homeTimeline'
-- @
--
-- >>> homeTimeline
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/home_timeline.json" []
-- >>> homeTimeline & #count ?~ 200
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/home_timeline.json" [("count","200")]
homeTimeline :: APIRequest StatusesHomeTimeline [Status]
homeTimeline :: APIRequest StatusesHomeTimeline [Status]
homeTimeline = Method
-> String -> APIQuery -> APIRequest StatusesHomeTimeline [Status]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" (String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/home_timeline.json") APIQuery
forall a. Default a => a
def
type StatusesHomeTimeline = '[
      "count" ':= Integer
    , "since_id" ':= Integer
    , "max_id" ':= Integer
    , "trim_user" ':= Bool
    , "exclude_replies" ':= Bool
    , "contributor_details" ':= Bool
    , "include_entities" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns query data asks the most recent tweets authored by the authenticating user that have been retweeted by others.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' 'retweetsOfMe'
-- @
--
-- >>> retweetsOfMe
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets_of_me.json" []
-- >>> retweetsOfMe & #count ?~ 100
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets_of_me.json" [("count","100")]
retweetsOfMe :: APIRequest StatusesRetweetsOfMe [Status]
retweetsOfMe :: APIRequest StatusesRetweetsOfMe [Status]
retweetsOfMe = Method
-> String -> APIQuery -> APIRequest StatusesRetweetsOfMe [Status]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" (String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/retweets_of_me.json") APIQuery
forall a. Default a => a
def
type StatusesRetweetsOfMe = '[
      "count" ':= Integer
    , "since_id" ':= Integer
    , "max_id" ':= Integer
    , "trim_user" ':= Bool
    , "include_entities" ':= Bool
    , "include_user_entities" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- * Tweets

-- | Returns query data that asks for the most recent retweets of the specified tweet
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'retweetsId' 1234567890
-- @
--
-- >>> retweetsId 1234567890
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" []
-- >>> retweetsId 1234567890 & #count ?~ 100
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/retweets/1234567890.json" [("count","100")]
retweetsId :: StatusId -> APIRequest StatusesRetweetsId [RetweetedStatus]
retweetsId :: StatusId -> APIRequest StatusesRetweetsId [RetweetedStatus]
retweetsId StatusId
status_id = Method
-> String
-> APIQuery
-> APIRequest StatusesRetweetsId [RetweetedStatus]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" String
uri APIQuery
forall a. Default a => a
def
  where uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/retweets/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ StatusId -> String
forall a. Show a => a -> String
show StatusId
status_id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json"
type StatusesRetweetsId = '[
      "count" ':= Integer
    , "trim_user" ':= Bool
    ]

-- | Returns query data asks a single Tweet, specified by the id parameter.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'showId' 1234567890
-- @
--
-- >>> showId 1234567890
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/show/1234567890.json" []
-- >>> showId 1234567890 & #include_my_retweet ?~ True
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/show/1234567890.json" [("include_my_retweet","true")]
showId :: StatusId -> APIRequest StatusesShowId Status
showId :: StatusId -> APIRequest StatusesShowId Status
showId StatusId
status_id = Method -> String -> APIQuery -> APIRequest StatusesShowId Status
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" String
uri APIQuery
forall a. Default a => a
def
  where uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/show/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ StatusId -> String
forall a. Show a => a -> String
show StatusId
status_id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json"
type StatusesShowId = '[
      "trim_user" ':= Bool
    , "include_my_retweet" ':= Bool
    , "include_entities" ':= Bool
    , "include_ext_alt_text" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns post data which destroys the status specified by the require ID parameter.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'destroyId' 1234567890
-- @
--
-- >>> destroyId 1234567890
-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/destroy/1234567890.json" []
destroyId :: StatusId -> APIRequest StatusesDestroyId Status
destroyId :: StatusId -> APIRequest StatusesDestroyId Status
destroyId StatusId
status_id = Method -> String -> APIQuery -> APIRequest StatusesDestroyId Status
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"POST" String
uri APIQuery
forall a. Default a => a
def
  where uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/destroy/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ StatusId -> String
forall a. Show a => a -> String
show StatusId
status_id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json"
type StatusesDestroyId = '[
      "trim_user" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns post data which updates the authenticating user's current status.
-- To upload an image to accompany the tweet, use 'updateWithMedia'.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'update' \"Hello World\"
-- @
--
-- >>> update "Hello World"
-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/update.json" [("status","Hello World")]
-- >>> update "Hello World" & #in_reply_to_status_id ?~ 1234567890
-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/update.json" [("in_reply_to_status_id","1234567890"),("status","Hello World")]
update :: T.Text -> APIRequest StatusesUpdate Status
update :: Text -> APIRequest StatusesUpdate Status
update Text
status = Method -> String -> APIQuery -> APIRequest StatusesUpdate Status
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"POST" String
uri [(Method
"status", Text -> PV
PVString Text
status)]
  where uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/update.json"
type StatusesUpdate = '[
      "in_reply_to_status_id" ':= Integer
    -- , "lat_long"
    -- , "place_id"
    , "display_coordinates" ':= Bool
    , "trim_user" ':= Bool
    , "media_ids" ':= [Integer]
    , "tweet_mode" ':= T.Text
    ]

-- | Returns post data which retweets a tweet, specified by ID.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'retweetId' 1234567890
-- @
--
-- >>> retweetId 1234567890
-- APIRequest "POST" "https://api.twitter.com/1.1/statuses/retweet/1234567890.json" []
retweetId :: StatusId -> APIRequest StatusesRetweetId RetweetedStatus
retweetId :: StatusId -> APIRequest StatusesRetweetId RetweetedStatus
retweetId StatusId
status_id = Method
-> String
-> APIQuery
-> APIRequest StatusesRetweetId RetweetedStatus
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"POST" String
uri APIQuery
forall a. Default a => a
def
  where uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/retweet/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ StatusId -> String
forall a. Show a => a -> String
show StatusId
status_id String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".json"
type StatusesRetweetId = '[
      "trim_user" ':= Bool
    ]

-- | Returns post data which updates the authenticating user's current status and attaches media for upload.
--
-- You can perform a search query using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'updateWithMedia' \"Hello World\" ('MediaFromFile' \"/home/thimura/test.jpeg\")
-- @
--
-- >>> updateWithMedia "Hello World" (MediaFromFile "/home/fuga/test.jpeg")
-- APIRequestMultipart "POST" "https://api.twitter.com/1.1/statuses/update_with_media.json" [("status","Hello World")]
updateWithMedia :: T.Text
                -> MediaData
                -> APIRequest StatusesUpdateWithMedia Status
updateWithMedia :: Text -> MediaData -> APIRequest StatusesUpdateWithMedia Status
updateWithMedia Text
tweet MediaData
mediaData =
    Method
-> String
-> APIQuery
-> [Part]
-> APIRequest StatusesUpdateWithMedia Status
forall (supports :: [Param Symbol *]) responseType.
Method
-> String -> APIQuery -> [Part] -> APIRequest supports responseType
APIRequestMultipart Method
"POST" String
uri [(Method
"status", Text -> PV
PVString Text
tweet)] [MediaData -> Part
mediaBody MediaData
mediaData]
  where
    uri :: String
uri = String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/update_with_media.json"
    mediaBody :: MediaData -> Part
mediaBody (MediaFromFile String
fp) = Text -> String -> Part
partFileSource Text
"media[]" String
fp
    mediaBody (MediaRequestBody String
filename RequestBody
filebody) = Text -> String -> RequestBody -> Part
forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
"media[]" String
filename RequestBody
filebody
type StatusesUpdateWithMedia = '[
      "possibly_sensitive" ':= Bool
    , "in_reply_to_status_id" ':= Integer
    -- , "lat_long"
    -- , "place_id"
    , "display_coordinates" ':= Bool
    , "tweet_mode" ':= T.Text
    ]

-- | Returns fully-hydrated tweet objects for up to 100 tweets per request, as specified by comma-separated values passed to the id parameter.
--
-- You can perform a request using 'call':
--
-- @
-- res <- 'call' twInfo mgr '$' 'lookup' [20, 432656548536401920]
-- @
--
-- >>> lookup [10]
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10")]
-- >>> lookup [10, 432656548536401920]
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("id","10,432656548536401920")]
-- >>> lookup [10, 432656548536401920] & #include_entities ?~ True
-- APIRequest "GET" "https://api.twitter.com/1.1/statuses/lookup.json" [("include_entities","true"),("id","10,432656548536401920")]
lookup :: [StatusId] -> APIRequest StatusesLookup [Status]
lookup :: [StatusId] -> APIRequest StatusesLookup [Status]
lookup [StatusId]
ids = Method -> String -> APIQuery -> APIRequest StatusesLookup [Status]
forall (supports :: [Param Symbol *]) responseType.
Method -> String -> APIQuery -> APIRequest supports responseType
APIRequest Method
"GET" (String
endpoint String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"statuses/lookup.json") [(Method
"id", [StatusId] -> PV
PVIntegerArray [StatusId]
ids)]
type StatusesLookup = '[
      "include_entities" ':= Bool
    , "trim_user" ':= Bool
    , "map" ':= Bool
    , "tweet_mode" ':= T.Text
    ]