-- | Helper functions for the command line tool.
module Web.Tweet.API.Internal where

import           Data.Void
import           Text.Megaparsec.Error
import           Web.Tweet.API
import           Web.Tweet.Types
import           Web.Tweet.Utils

type Filter = Timeline -> Timeline

-- | Show a user profile given screen name, how many tweets to return,
-- and whether to print them in color.
showProfile :: String -> Int -> Bool -> FilePath -> IO String
showProfile :: String -> Int -> Bool -> String -> IO String
showProfile String
sn Int
count Bool
color = (Either (ParseErrorBundle String Void) Timeline -> String)
-> IO (Either (ParseErrorBundle String Void) Timeline) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color) (IO (Either (ParseErrorBundle String Void) Timeline) -> IO String)
-> (String -> IO (Either (ParseErrorBundle String Void) Timeline))
-> String
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) Timeline)
getProfile String
sn Int
count

-- | Show the most successful tweets by a given user, given their screen name.
showBest :: String -> Int -> Bool -> FilePath -> IO String
showBest :: String -> Int -> Bool -> String -> IO String
showBest String
sn Int
n Bool
color = (Timeline -> String) -> IO Timeline -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color (Either (ParseErrorBundle String Void) Timeline -> String)
-> (Timeline -> Either (ParseErrorBundle String Void) Timeline)
-> Timeline
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Either (ParseErrorBundle String Void) Timeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Timeline -> Either (ParseErrorBundle String Void) Timeline)
-> (Timeline -> Timeline)
-> Timeline
-> Either (ParseErrorBundle String Void) Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Timeline -> Timeline
forall a. Int -> [a] -> [a]
take Int
n (Timeline -> Timeline)
-> (Timeline -> Timeline) -> Timeline -> Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Timeline
hits) (IO Timeline -> IO String)
-> (String -> IO Timeline) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int -> String -> IO Timeline
getAll String
sn Maybe Int
forall a. Maybe a
Nothing

-- | Show the most successful tweets by a given user, given their screen name. Additionally filter out replies.
showBest' :: String -> Int -> Bool -> FilePath -> IO String
showBest' :: String -> Int -> Bool -> String -> IO String
showBest' String
sn Int
n Bool
color = (Timeline -> String) -> IO Timeline -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color (Either (ParseErrorBundle String Void) Timeline -> String)
-> (Timeline -> Either (ParseErrorBundle String Void) Timeline)
-> Timeline
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Either (ParseErrorBundle String Void) Timeline
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Timeline -> Either (ParseErrorBundle String Void) Timeline)
-> (Timeline -> Timeline)
-> Timeline
-> Either (ParseErrorBundle String Void) Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Timeline -> Timeline
forall a. Int -> [a] -> [a]
take Int
n (Timeline -> Timeline)
-> (Timeline -> Timeline) -> Timeline -> Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Timeline
hits') (IO Timeline -> IO String)
-> (String -> IO Timeline) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int -> String -> IO Timeline
getAll String
sn Maybe Int
forall a. Maybe a
Nothing

showReplies :: String -> Int -> Bool -> FilePath -> IO String
showReplies :: String -> Int -> Bool -> String -> IO String
showReplies String
uname Int
twid Bool
color = (Either (ParseErrorBundle String Void) Timeline -> String)
-> IO (Either (ParseErrorBundle String Void) Timeline) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color) (IO (Either (ParseErrorBundle String Void) Timeline) -> IO String)
-> (String -> IO (Either (ParseErrorBundle String Void) Timeline))
-> String
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) Timeline)
getReplies String
uname Int
twid

-- | Display user timeline
showTimeline :: Int -> Bool -> FilePath -> IO String
showTimeline :: Int -> Bool -> String -> IO String
showTimeline Int
count Bool
color = (Either (ParseErrorBundle String Void) Timeline -> String)
-> IO (Either (ParseErrorBundle String Void) Timeline) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color) (IO (Either (ParseErrorBundle String Void) Timeline) -> IO String)
-> (String -> IO (Either (ParseErrorBundle String Void) Timeline))
-> String
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String -> IO (Either (ParseErrorBundle String Void) Timeline)
getTimeline Int
count

showFilteredTL :: [Filter] -> String -> Int -> Bool -> FilePath -> IO String
showFilteredTL :: [Timeline -> Timeline]
-> String -> Int -> Bool -> String -> IO String
showFilteredTL [Timeline -> Timeline]
filters String
sn Int
count Bool
color = (Either (ParseErrorBundle String Void) Timeline -> String)
-> IO (Either (ParseErrorBundle String Void) Timeline) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color (Either (ParseErrorBundle String Void) Timeline -> String)
-> (Either (ParseErrorBundle String Void) Timeline
    -> Either (ParseErrorBundle String Void) Timeline)
-> Either (ParseErrorBundle String Void) Timeline
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timeline -> Timeline)
-> Either (ParseErrorBundle String Void) Timeline
-> Either (ParseErrorBundle String Void) Timeline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Timeline -> Timeline)
 -> (Timeline -> Timeline) -> Timeline -> Timeline)
-> (Timeline -> Timeline)
-> [Timeline -> Timeline]
-> Timeline
-> Timeline
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Timeline -> Timeline)
-> (Timeline -> Timeline) -> Timeline -> Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Timeline -> Timeline
forall a. a -> a
id [Timeline -> Timeline]
filters)) (IO (Either (ParseErrorBundle String Void) Timeline) -> IO String)
-> (String -> IO (Either (ParseErrorBundle String Void) Timeline))
-> String
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Int
-> String
-> IO (Either (ParseErrorBundle String Void) Timeline)
getProfile String
sn Int
count

-- | Display user timeline in color, as appropriate
showTweets :: Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets :: Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color = (ParseErrorBundle String Void -> String)
-> (String -> String)
-> Either (ParseErrorBundle String Void) String
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle String Void -> String
forall a. Show a => a -> String
show String -> String
forall a. a -> a
id (Either (ParseErrorBundle String Void) String -> String)
-> (Either (ParseErrorBundle String Void) Timeline
    -> Either (ParseErrorBundle String Void) String)
-> Either (ParseErrorBundle String Void) Timeline
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Timeline -> String)
-> Either (ParseErrorBundle String Void) Timeline
-> Either (ParseErrorBundle String Void) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (if Bool
color then Timeline -> String
displayTimelineColor else Timeline -> String
displayTimeline)

-- | Display a user's favorites
showFavorites :: Int -> String -> Bool -> FilePath -> IO String
showFavorites :: Int -> String -> Bool -> String -> IO String
showFavorites Int
count String
sn Bool
color = (Either (ParseErrorBundle String Void) Timeline -> String)
-> IO (Either (ParseErrorBundle String Void) Timeline) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either (ParseErrorBundle String Void) Timeline -> String
showTweets Bool
color) (IO (Either (ParseErrorBundle String Void) Timeline) -> IO String)
-> (String -> IO (Either (ParseErrorBundle String Void) Timeline))
-> String
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> String
-> String
-> IO (Either (ParseErrorBundle String Void) Timeline)
getFavorites Int
count String
sn