-- Copyright: 2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli module Cltw.User ( executeUsersCommand ) where import Control.Monad.Error import Control.Monad.Reader import Network.Curl import Text.HTML.TagSoup import Text.Printf import Cltw.Common import Cltw.Opts data User = User { userId :: Integer , userName :: String , userScreenName :: String } extractUser :: [Tag String] -> User extractUser uts = User (read $ tt "id" uts) (tt "name" uts) (tt "screen_name" uts) where tt tag u = fromTagText . head . filter isTagText . head . sections (~== ("<" ++ tag ++ ">")) $ u extractUsers :: [Tag String] -> [User] extractUsers = map extractUser . sections (~== "") extractCursor :: [Tag String] -> String extractCursor = fromTagText . head . filter isTagText . head . sections (~== "") displayUsersShort :: [User] -> Cltw () displayUsersShort = liftIO . mapM_ (putStrLn . userScreenName) displayUsersStandard :: [User] -> Cltw () displayUsersStandard us = do let displayLines = map (\u -> printf "%-20s %-20s %-d" (userScreenName u) (userName u) (userId u) ) us liftIO $ mapM_ putStrLn displayLines displayUsers :: [User] -> Cltw () displayUsers usersXml = do verbosity <- asks optVerbosity case verbosity of 0 -> displayUsersShort usersXml _ -> displayUsersStandard usersXml getUsers :: String -> String -> Cltw () getUsers _ "0" = return () getUsers uri cursor = do eErr <- liftIO $ withCurlDo $ do curl <- initialize r <- do_curl_ curl (uri ++ "?cursor=" ++ cursor) method_GET :: IO CurlResponse let d = respBody r if respCurlCode r /= CurlOK || respStatus r /= 200 then return . Left $ d else return . Right $ d documentString <- either throwError return eErr let document = parseTags documentString let users = extractUsers document let nextCursor = extractCursor document displayUsers users getUsers uri nextCursor executeUsersCommand :: String -> Cltw () executeUsersCommand apiSuffix = do uri <- constructUri $ "statuses/" ++ apiSuffix echo <- asks optEchoReqUri when echo $ liftIO $ putStrLn uri getUsers uri "-1"