1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
import Common
import Web.Twitter.Conduit
import Web.Twitter.Types.Lens
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.HTTP.Conduit as HTTP
import System.Directory
import System.FilePath
import System.Process
ensureDirectoryExist :: FilePath -> IO FilePath
ensureDirectoryExist dir = do
createDirectoryIfMissing True dir
return dir
confdir :: IO FilePath
confdir = fmap (</> ".twitter-conduit") getHomeDirectory >>= ensureDirectoryExist
iconPath :: IO FilePath
iconPath = (</> "icons") <$> confdir >>= ensureDirectoryExist
main :: IO ()
main = do
twInfo <- getTWInfoFromEnv
mgr <- newManager tlsManagerSettings
runResourceT $ do
src <- stream twInfo mgr userstream
runConduit $ src .| CL.mapM_ (liftIO . printTL)
showStatus :: AsStatus s => s -> T.Text
showStatus s =
T.concat
[ s ^. user . userScreenName
, ":"
, s ^. text
]
printTL :: StreamingAPI -> IO ()
printTL (SStatus s) = T.putStrLn . showStatus $ s
printTL (SRetweetedStatus s) =
T.putStrLn $
T.concat
[ s ^. user . userScreenName
, ": RT @"
, showStatus (s ^. rsRetweetedStatus)
]
printTL (SEvent event)
| (event ^. evEvent) == "favorite" || (event ^. evEvent) == "unfavorite"
, Just (ETStatus st) <- event ^. evTargetObject = do
let (fromUser, fromIcon) = evUserInfo (event ^. evSource)
(toUser, _toIcon) = evUserInfo (event ^. evTarget)
evUserInfo (ETUser u) = (u ^. userScreenName, u ^. userProfileImageURL)
evUserInfo _ = ("", Nothing)
header = T.concat [event ^. evEvent, "[", fromUser, " -> ", toUser, "]"]
T.putStrLn $ T.concat [header, " :: ", showStatus st]
icon <- case fromIcon of
Just iconUrl -> Just <$> fetchIcon (T.unpack fromUser) (T.unpack iconUrl)
Nothing -> return Nothing
notifySend header (showStatus st) icon
printTL s = print s
notifySend :: T.Text -> T.Text -> Maybe FilePath -> IO ()
notifySend header content icon = do
let ic = maybe [] (\i -> ["-i", i]) icon
void $ rawSystem "notify-send" $ [T.unpack header, T.unpack content] ++ ic
fetchIcon ::
-- | screen name
String ->
-- | icon url
String ->
IO String
fetchIcon sn url = do
ipath <- iconPath
let fname = ipath </> sn ++ "__" ++ takeFileName url
exists <- doesFileExist fname
unless exists $ do
req <- parseRequest url
mgr <- newManager tlsManagerSettings
runResourceT $ do
body <- http req mgr
runConduit $ HTTP.responseBody body .| CB.sinkFile fname
return fname
|
