twitter-conduit-0.0.1: sample/userstream.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternGuards #-}

import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Text.IO as T
import qualified Data.Text as T
import System.Process
import Control.Monad
import Control.Monad.IO.Class
import Control.Applicative
import System.FilePath
import System.Directory
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import Network.HTTP.Conduit

import Web.Twitter.Conduit
import Common
import Control.Lens

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 = runTwitterFromEnv' $ do
    src <- stream userstream
    src C.$$+- CL.mapM_ (^! act (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 :: String -- ^ screen name
          -> String -- ^ icon url
          -> IO String
fetchIcon sn url = do
    ipath <- iconPath
    let fname = ipath </> sn ++ "__" ++ takeFileName url
    exists <- doesFileExist fname
    unless exists $ withManager $ \mgr -> do
        req <- liftIO $ parseUrl url
        body <- http req mgr
        responseBody body $$+- CB.sinkFile fname
    return fname