User.hs

-- Copyright: 2010 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli <dino@ui3.info>

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 (~== "<user>")


extractCursor :: [Tag String] -> String
extractCursor = fromTagText . head . filter isTagText
   . head . sections (~== "<next_cursor>")


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"