-- | Miscellaneous functions that don't fit the project directly
module Web.Tweet.Utils (
    hits
  , hits'
  , getTweets
  , displayTimeline
  , displayTimelineColor
  , lineByKey
  , bird
  , getConfigData
  , filterQuotes
  , filterReplies
  , filterRTs
  ) where

import           Control.Composition
import qualified Data.ByteString        as BS2
import qualified Data.ByteString.Char8  as BS
import           Data.List
import           Data.List.Extra
import           Data.Void
import           Lens.Micro.Extras
import           Text.Megaparsec
import           Web.Tweet.Parser
import           Web.Tweet.Types
import           Web.Tweet.Utils.Colors

-- | filter out retweets, and sort by most successful.
hits :: Timeline -> Timeline
hits :: Timeline -> Timeline
hits = Timeline -> Timeline
sortTweets (Timeline -> Timeline)
-> (Timeline -> Timeline) -> Timeline -> Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Timeline
filterRTs

-- | Filter out retweets and replies, and sort by most sucessful.
hits' :: Timeline -> Timeline
hits' :: Timeline -> Timeline
hits' = Timeline -> Timeline
hits (Timeline -> Timeline)
-> (Timeline -> Timeline) -> Timeline -> Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeline -> Timeline
filterReplies

-- | Filter out retweets
filterRTs :: Timeline -> Timeline
filterRTs :: Timeline -> Timeline
filterRTs = (TweetEntity -> Bool) -> Timeline -> Timeline
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Char]
"RT @") ([Char] -> Bool) -> (TweetEntity -> [Char]) -> TweetEntity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
4 ([Char] -> [Char])
-> (TweetEntity -> [Char]) -> TweetEntity -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Char] TweetEntity [Char] -> TweetEntity -> [Char]
forall a s. Getting a s a -> s -> a
view Getting [Char] TweetEntity [Char]
Lens' TweetEntity [Char]
text)

-- | Filter out replies
filterReplies :: Timeline -> Timeline
filterReplies :: Timeline -> Timeline
filterReplies = (TweetEntity -> Bool) -> Timeline -> Timeline
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=[Char]
"@") ([Char] -> Bool) -> (TweetEntity -> [Char]) -> TweetEntity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 ([Char] -> [Char])
-> (TweetEntity -> [Char]) -> TweetEntity -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Char] TweetEntity [Char] -> TweetEntity -> [Char]
forall a s. Getting a s a -> s -> a
view Getting [Char] TweetEntity [Char]
Lens' TweetEntity [Char]
text)

-- | Filter out quotes
filterQuotes :: Timeline -> Timeline
filterQuotes :: Timeline -> Timeline
filterQuotes = (TweetEntity -> Bool) -> Timeline -> Timeline
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe TweetEntity -> Maybe TweetEntity -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe TweetEntity
forall a. Maybe a
Nothing) (Maybe TweetEntity -> Bool)
-> (TweetEntity -> Maybe TweetEntity) -> TweetEntity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe TweetEntity) TweetEntity (Maybe TweetEntity)
-> TweetEntity -> Maybe TweetEntity
forall a s. Getting a s a -> s -> a
view Getting (Maybe TweetEntity) TweetEntity (Maybe TweetEntity)
Lens' TweetEntity (Maybe TweetEntity)
quoted)

-- | Get a list of tweets from a response, returning author, favorites, retweets, and content.
getTweets :: BS2.ByteString -> Either (ParseErrorBundle String Void) Timeline
getTweets :: ByteString -> Either (ParseErrorBundle [Char] Void) Timeline
getTweets = Parsec Void [Char] Timeline
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] Void) Timeline
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void [Char] Timeline
parseTweet [Char]
"" ([Char] -> Either (ParseErrorBundle [Char] Void) Timeline)
-> (ByteString -> [Char])
-> ByteString
-> Either (ParseErrorBundle [Char] Void) Timeline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack

-- | Display Timeline without color
displayTimeline :: Timeline -> String
displayTimeline :: Timeline -> [Char]
displayTimeline (TweetEntity [Char]
content Maybe Int
_ [Char]
u [Char]
sn Int
idTweet [[Char]]
_ Maybe TweetEntity
Nothing Int
rts Int
fave:Timeline
rest) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
u
    , [Char]
" ("
    , [Char]
sn
    , [Char]
")"
    ,[Char]
":\n    "
    ,[Char] -> [Char]
fixNewline [Char]
content
    ,[Char]
"\n    "
    , [Char]
"💜"
    -- , "♥ "
    ,Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fave
    , [Char]
" \61561  "
    -- ," ♺ "
    ,Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rts
    , [Char]
"  "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idTweet
    ,[Char]
"\n\n"
    ,Timeline -> [Char]
displayTimeline Timeline
rest]
displayTimeline (TweetEntity [Char]
content Maybe Int
_ [Char]
u [Char]
sn Int
idTweet [[Char]]
_ (Just TweetEntity
q) Int
rts Int
fave:Timeline
rest) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
u
    , [Char]
" ("
    , [Char]
sn
    , [Char]
")"
    , [Char]
":\n    "
    , [Char] -> [Char]
fixNewline [Char]
content
    , [Char]
"\n    "
    , [Char]
"💜"
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fave
    , [Char]
" \61561  "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rts
    , [Char]
"  "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idTweet
    , [Char]
"\n    "
    , TweetEntity -> [Char]
_name TweetEntity
q
    , [Char]
" ("
    , TweetEntity -> [Char]
_screenName TweetEntity
q
    , [Char]
")"
    , [Char]
": "
    , TweetEntity -> [Char]
_text TweetEntity
q
    , [Char]
"\n\n"
    , Timeline -> [Char]
displayTimeline Timeline
rest]
displayTimeline [] = []

bird :: String
bird :: [Char]
bird = [Char] -> [Char]
toPlainBlue [Char]
"🐦\n"

-- | Display Timeline in color
displayTimelineColor :: Timeline -> String
displayTimelineColor :: Timeline -> [Char]
displayTimelineColor (TweetEntity [Char]
content Maybe Int
_ [Char]
u [Char]
sn Int
idTweet [[Char]]
_ Maybe TweetEntity
Nothing Int
rts Int
fave:Timeline
rest) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char] -> [Char]
toYellow [Char]
u
    , [Char]
" ("
    , [Char]
sn
    , [Char]
")"
    , [Char]
":\n    "
    , [Char] -> [Char]
fixNewline [Char]
content
    , [Char]
"\n    "
    , [Char] -> [Char]
toRed [Char]
"💜"
    , [Char]
" "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fave
    , [Char] -> [Char]
toGreen [Char]
" \61561  " -- ♺ "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rts
    , [Char]
"  "
    , [Char] -> [Char]
toBlue (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idTweet)
    , [Char]
"\n\n"
    , Timeline -> [Char]
displayTimelineColor Timeline
rest]
displayTimelineColor (TweetEntity [Char]
content Maybe Int
_ [Char]
u [Char]
sn Int
idTweet [[Char]]
_ (Just TweetEntity
q) Int
rts Int
fave:Timeline
rest) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char] -> [Char]
toYellow [Char]
u
    , [Char]
" ("
    , [Char]
sn
    , [Char]
")"
    , [Char]
":\n    "
    , [Char] -> [Char]
fixNewline [Char]
content
    , [Char]
"\n    "
    , [Char] -> [Char]
toRed [Char]
"💜"
    , [Char]
" "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
fave
    , [Char] -> [Char]
toGreen [Char]
" \61561  "
    , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
rts
    , [Char]
"  "
    , [Char] -> [Char]
toBlue (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idTweet)
    , [Char]
"\n    "
    , [Char] -> [Char]
toYellow ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ TweetEntity -> [Char]
_name TweetEntity
q
    , [Char]
" ("
    , TweetEntity -> [Char]
_screenName TweetEntity
q
    , [Char]
")"
    , [Char]
": "
    , TweetEntity -> [Char]
_text TweetEntity
q
    , [Char]
"\n\n"
    , Timeline -> [Char]
displayTimelineColor Timeline
rest]
displayTimelineColor [] = []

-- | When displaying, newlines should include indentation.
fixNewline :: String -> String
fixNewline :: [Char] -> [Char]
fixNewline = [Char] -> [Char] -> [Char] -> [Char]
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace [Char]
"\n" [Char]
"\n    "

-- | sort tweets by most successful
sortTweets :: Timeline -> Timeline
sortTweets :: Timeline -> Timeline
sortTweets = (TweetEntity -> TweetEntity -> Ordering) -> Timeline -> Timeline
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy TweetEntity -> TweetEntity -> Ordering
compareTweet
    where compareTweet :: TweetEntity -> TweetEntity -> Ordering
compareTweet (TweetEntity [Char]
_ Maybe Int
_ [Char]
_ [Char]
_ Int
_ [[Char]]
_ Maybe TweetEntity
_ Int
r1 Int
f1) (TweetEntity [Char]
_ Maybe Int
_ [Char]
_ [Char]
_ Int
_ [[Char]]
_ Maybe TweetEntity
_ Int
r2 Int
f2) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
f2) (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
f1)

-- | helper function to get the key as read from a file
keyLinePie :: String -> String
keyLinePie :: [Char] -> [Char]
keyLinePie = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':')

-- | Pick out a key value from a key
lineByKey :: BS.ByteString -> [(BS.ByteString, BS.ByteString)] -> BS.ByteString
lineByKey :: ByteString -> [(ByteString, ByteString)] -> ByteString
lineByKey = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString
    -> [(ByteString, ByteString)] -> (ByteString, ByteString))
-> ByteString
-> [(ByteString, ByteString)]
-> ByteString
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* [(ByteString, ByteString)] -> (ByteString, ByteString)
forall a. [a] -> a
head ([(ByteString, ByteString)] -> (ByteString, ByteString))
-> (ByteString
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> ByteString
-> [(ByteString, ByteString)]
-> (ByteString, ByteString)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* (((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (((ByteString, ByteString) -> Bool)
 -> [(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> (ByteString -> (ByteString, ByteString) -> Bool)
-> ByteString
-> [(ByteString, ByteString)]
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> (ByteString, ByteString)
-> Bool
forall b c a d. (b -> c) -> (a -> c -> d) -> a -> b -> d
.@ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==)))

-- | Filter a line of a file for only the actual data and no descriptors
filterLine :: String -> String
filterLine :: [Char] -> [Char]
filterLine = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" :" :: String))) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse

-- | Get pairs of "key" to search for and actual values
getConfigData :: FilePath -> IO [(BS.ByteString, BS.ByteString)]
getConfigData :: [Char] -> IO [(ByteString, ByteString)]
getConfigData [Char]
filepath = [ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([ByteString] -> [ByteString] -> [(ByteString, ByteString)])
-> IO [ByteString]
-> IO ([ByteString] -> [(ByteString, ByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
keys IO ([ByteString] -> [(ByteString, ByteString)])
-> IO [ByteString] -> IO [(ByteString, ByteString)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [ByteString]
content
    where content :: IO [ByteString]
content = ([Char] -> ByteString) -> [[Char]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> ByteString
BS.pack ([Char] -> ByteString)
-> ([Char] -> [Char]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
filterLine) ([[Char]] -> [ByteString])
-> ([Char] -> [[Char]]) -> [Char] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [ByteString]) -> IO [Char] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
file
          keys :: IO [ByteString]
keys    = ([Char] -> ByteString) -> [[Char]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> ByteString
BS.pack ([Char] -> ByteString)
-> ([Char] -> [Char]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
keyLinePie) ([[Char]] -> [ByteString])
-> ([Char] -> [[Char]]) -> [Char] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> [ByteString]) -> IO [Char] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
file
          file :: IO [Char]
file    = [Char] -> IO [Char]
readFile [Char]
filepath