-- | Exports the `Tweet` type, a datatype for building tweets easily
module Web.Tweet.Types where

import           Lens.Micro
import           Web.Authenticate.OAuth

-- | Data type for our request: consists of the status text, whether to trium u information in the response, the handles to mention, and optionally the id of the status to reply to.
data Tweet = Tweet
    { Tweet -> String
_status  :: String
    , Tweet -> [String]
_handles :: [String]
    , Tweet -> Maybe Int
_replyID :: Maybe Int
    }

-- | Data type for tweets as they are returned
data TweetEntity = TweetEntity
    { TweetEntity -> String
_text       :: String
    , TweetEntity -> Maybe Int
_replyTo    :: Maybe Int
    , TweetEntity -> String
_name       :: String
    , TweetEntity -> String
_screenName :: String
    , TweetEntity -> Int
_tweetId    :: Int
    , TweetEntity -> [String]
_withheld   :: [String]
    , TweetEntity -> Maybe TweetEntity
_quoted     :: Maybe TweetEntity
    , TweetEntity -> Int
_retweets   :: Int
    , TweetEntity -> Int
_favorites  :: Int
    } deriving (TweetEntity -> TweetEntity -> Bool
(TweetEntity -> TweetEntity -> Bool)
-> (TweetEntity -> TweetEntity -> Bool) -> Eq TweetEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TweetEntity -> TweetEntity -> Bool
$c/= :: TweetEntity -> TweetEntity -> Bool
== :: TweetEntity -> TweetEntity -> Bool
$c== :: TweetEntity -> TweetEntity -> Bool
Eq)

pricklyTweet :: Tweet
pricklyTweet :: Tweet
pricklyTweet = String -> [String] -> Maybe Int -> Tweet
Tweet String
forall a. HasCallStack => a
undefined [] Maybe Int
forall a. Maybe a
Nothing

-- | Stores data like (name, text, favoriteCount, retweetCount)
type Timeline = [TweetEntity]

-- | Contains an 'OAuth' and a 'Credential'; encapsulates everything needed to sign a request.
type Config = (OAuth, Credential)

-- | Lens for `Tweet` accessing the `status` field.
status :: Lens' Tweet String
status :: (String -> f String) -> Tweet -> f Tweet
status String -> f String
f tweet :: Tweet
tweet@Tweet { _status :: Tweet -> String
_status = String
str } = (String -> Tweet) -> f String -> f Tweet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
str' -> Tweet
tweet { _status :: String
_status = String
str'}) (String -> f String
f String
str)

-- | Lens for `Tweet` accessing the `handles` field.
handles :: Lens' Tweet [String]
handles :: ([String] -> f [String]) -> Tweet -> f Tweet
handles [String] -> f [String]
f tweet :: Tweet
tweet@Tweet { _handles :: Tweet -> [String]
_handles = [String]
hs } = ([String] -> Tweet) -> f [String] -> f Tweet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[String]
hs' -> Tweet
tweet { _handles :: [String]
_handles = [String]
hs'}) ([String] -> f [String]
f [String]
hs)

-- | Lens for `Tweet` accessing the `_replyID` field.
replyID :: Lens' Tweet (Maybe Int)
replyID :: (Maybe Int -> f (Maybe Int)) -> Tweet -> f Tweet
replyID Maybe Int -> f (Maybe Int)
f tweet :: Tweet
tweet@Tweet { _replyID :: Tweet -> Maybe Int
_replyID = Maybe Int
reply } = (Maybe Int -> Tweet) -> f (Maybe Int) -> f Tweet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Int
reply' -> Tweet
tweet { _replyID :: Maybe Int
_replyID = Maybe Int
reply'}) (Maybe Int -> f (Maybe Int)
f Maybe Int
reply)

-- | Lens for `TweetEntity` accessing the `_text` field.
text :: Lens' TweetEntity String
text :: (String -> f String) -> TweetEntity -> f TweetEntity
text String -> f String
f tweet :: TweetEntity
tweet@TweetEntity { _text :: TweetEntity -> String
_text = String
txt } = (String -> TweetEntity) -> f String -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
txt' -> TweetEntity
tweet { _text :: String
_text = String
txt'}) (String -> f String
f String
txt)

-- | Lens for `TweetEntity` accessing the `_name` field.
name :: Lens' TweetEntity String
name :: (String -> f String) -> TweetEntity -> f TweetEntity
name String -> f String
f tweet :: TweetEntity
tweet@TweetEntity { _name :: TweetEntity -> String
_name = String
nam } = (String -> TweetEntity) -> f String -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
nam' -> TweetEntity
tweet { _name :: String
_name = String
nam'}) (String -> f String
f String
nam)

-- | Lens for `TweetEntity` accessing the `_screenName` field.
screenName :: Lens' TweetEntity String
screenName :: (String -> f String) -> TweetEntity -> f TweetEntity
screenName String -> f String
f tweet :: TweetEntity
tweet@TweetEntity { _screenName :: TweetEntity -> String
_screenName = String
scr } = (String -> TweetEntity) -> f String -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
scr' -> TweetEntity
tweet { _screenName :: String
_screenName = String
scr'}) (String -> f String
f String
scr)

-- | Lens for `TweetEntity` accessing the `_tweetId` field.
tweetId :: Lens' TweetEntity Int
tweetId :: (Int -> f Int) -> TweetEntity -> f TweetEntity
tweetId Int -> f Int
f tweet :: TweetEntity
tweet@TweetEntity { _tweetId :: TweetEntity -> Int
_tweetId = Int
tw } = (Int -> TweetEntity) -> f Int -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
tw' -> TweetEntity
tweet { _tweetId :: Int
_tweetId = Int
tw'}) (Int -> f Int
f Int
tw)

-- | Lens for `TweetEntity` accessing the `_quoted` field.
quoted :: Lens' TweetEntity (Maybe TweetEntity)
quoted :: (Maybe TweetEntity -> f (Maybe TweetEntity))
-> TweetEntity -> f TweetEntity
quoted Maybe TweetEntity -> f (Maybe TweetEntity)
f tweet :: TweetEntity
tweet@TweetEntity { _quoted :: TweetEntity -> Maybe TweetEntity
_quoted = Maybe TweetEntity
q } = (Maybe TweetEntity -> TweetEntity)
-> f (Maybe TweetEntity) -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe TweetEntity
q' -> TweetEntity
tweet { _quoted :: Maybe TweetEntity
_quoted = Maybe TweetEntity
q'}) (Maybe TweetEntity -> f (Maybe TweetEntity)
f Maybe TweetEntity
q)

-- | Lens for `TweetEntity` accessing the `_retweets` field.
retweets :: Lens' TweetEntity Int
retweets :: (Int -> f Int) -> TweetEntity -> f TweetEntity
retweets Int -> f Int
f tweet :: TweetEntity
tweet@TweetEntity { _retweets :: TweetEntity -> Int
_retweets = Int
rts } = (Int -> TweetEntity) -> f Int -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
rts' -> TweetEntity
tweet { _retweets :: Int
_retweets = Int
rts'}) (Int -> f Int
f Int
rts)

-- | Lens for `TweetEntity` accessing the `_favorites` field.
favorites :: Lens' TweetEntity Int
favorites :: (Int -> f Int) -> TweetEntity -> f TweetEntity
favorites Int -> f Int
f tweet :: TweetEntity
tweet@TweetEntity { _favorites :: TweetEntity -> Int
_favorites = Int
fav } = (Int -> TweetEntity) -> f Int -> f TweetEntity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
fav' -> TweetEntity
tweet { _favorites :: Int
_favorites = Int
fav'}) (Int -> f Int
f Int
fav)