module Main
where

import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (forever, when)
import Data.List ((\\))
import System.Exit (ExitCode(..), exitWith)
import System.IO (hPutStrLn, stderr)

import CommandLine
import Configuration (Cfg(..))
import ExitCodes
import Mail
import Twitter.Http
import Twitter.Status
import Twitter.User


-- |A wrapper around threadDelay which takes seconds instead of
-- microseconds as its argument.
thread_sleep :: Int -> IO ()
thread_sleep seconds = do
  let microseconds = seconds * (10 ^ (6 :: Int))
  threadDelay microseconds


-- |Given a 'Message', 'Status', and default date, update that
-- message's body and subject with the information contained in the
-- status. Adds a /Date: / header, and returns the updated message.
message_from_status :: Message -> String -> Status -> Message
message_from_status message default_date status =
  message { subject = "Twat: " ++ (screen_name (user status)),
            body    = (pretty_print status),
            headers = ((headers message) ++ ["Date: " ++ date])}
  where
    -- Use the Status' created_at date if it can be coerced into
    -- RFC822 format.
    date = case (created_at_to_rfc822 $ created_at status) of
             Nothing -> default_date
             Just c  -> c

-- | If the given Message is not Nothing, send a copy of it for every
-- Status in the list.
send_messages :: Maybe Message -> [Status] -> IO ()
send_messages maybe_message statuses =
  case maybe_message of
    Nothing -> return ()
    Just message -> do
      default_date <- rfc822_now
      let mfs = message_from_status message (default_date)
      let messages = map mfs statuses
      sendmail_results <- mapM sendmail messages
      _ <- mapM print_sendmail_result sendmail_results
      return ()



-- | Display the number of skipped replies if ignore_replies is true
--   and verbose is enabled.
mention_replies :: Cfg -> [Status] -> IO ()
mention_replies cfg ss = do
  let replies  = filter reply ss
  when ((ignore_replies cfg) && (verbose cfg)) $ do
    let countstr = show $ length replies
    putStrLn $ "Ignoring " ++ countstr ++ " replies."


-- | Display the number of skipped retweets if ignore_retweets is true
--   and verbose is enabled.
mention_retweets :: Cfg -> [Status] -> IO ()
mention_retweets cfg ss = do
  let retweets = filter retweet ss
  when ((ignore_retweets cfg) && (verbose cfg)) $ do
    let countstr = show $ length retweets
    putStrLn  $ "Ignoring " ++ countstr ++ " retweets."



-- | Filter out replies/retweets based on the configuration.
filter_statuses :: Cfg -> [Status] -> [Status]
filter_statuses cfg ss =
  good_statuses
  where
  replies  = filter reply ss
  retweets = filter retweet ss

  good_statuses' = case (ignore_replies cfg) of
                         True  -> ss \\ replies
                         False -> ss

  good_statuses = case (ignore_retweets cfg) of
                    True  -> good_statuses' \\ retweets
                    False -> good_statuses'



-- | This is the main recursive loop. It takes a the configuration, a
--   username, a latest_status_id, and optionally a 'Message' as
--   arguments. The latest_status_id is the last status (that we know
--   of) to be posted to username's Twitter account. If we find any
--   newer statuses when we check, they are printed and optionally
--   emailed (if a 'Message' was supplied). Then, the process repeats.
recurse :: Cfg -> String -> Integer -> (Maybe Message) -> IO ()
recurse cfg username latest_status_id maybe_message = do
  thread_sleep (heartbeat cfg)
  xmldata <- get_user_new_statuses username latest_status_id

  -- Parsing an empty result can blow up. Just pretend there are
  -- no new statuses in that case.
  let new_statuses = case xmldata of
                       Just xml -> parse_statuses xml
                       Nothing  -> []

  case (length new_statuses) of
    0 ->
      do_recurse latest_status_id
    _ -> do

      mention_replies cfg new_statuses
      mention_retweets cfg new_statuses

      let good_statuses = filter_statuses cfg new_statuses

      _ <- mapM (putStrLn . pretty_print) good_statuses

      send_messages maybe_message good_statuses

      let new_latest_status_id = get_max_status_id new_statuses
      do_recurse new_latest_status_id

  where
    -- This lets us write all of these parameters once rather
    -- than... more than once.
    do_recurse :: Integer -> IO ()
    do_recurse lsi = recurse cfg username lsi maybe_message


-- | Try continually to download username's timeline, and determine the
--   latest status id to be posted once we have done so.
get_latest_status_id :: Int -> String -> IO Integer
get_latest_status_id delay username = do
  xmldata <- get_user_timeline username

  let initial_statuses = case xmldata of
                           Just xml -> parse_statuses xml
                           Nothing -> []

  case (length initial_statuses) of
    0 -> do
      -- If the HTTP part barfs, try again after a while.
      putStrLn ("Couldn't retrieve " ++ username ++ "'s timeline. Retrying...")
      thread_sleep delay
      get_latest_status_id delay username
    _ -> return (get_max_status_id initial_statuses)



-- | This function wraps two steps. First, we need to find the latest
--   status id posted by username. Once we have that, we can begin the
--   recursive loop that checks for updates forever. The message
--   argument is optional and is passed to recurse in case the updates
--   should be emailed.
run_twat :: Cfg -> Maybe Message -> String -> IO ()
run_twat cfg msg username = do
  latest_status_id <- get_latest_status_id (heartbeat cfg) username
  recurse cfg username latest_status_id msg
  return ()



-- | Take advantage of the Maybe monad to only return a message when
--   we have both a "to" and "from" address.
construct_message :: Cfg -> Maybe Message
construct_message cfg = do
  to_addr <- to_address cfg
  from_addr <- from_address cfg
  return $ make_msg to_addr from_addr
  where
    make_msg t f = Message { headers = default_headers,
                             body = "",
                             subject = "",
                             to = t,
                             from = f }

-- |The main function just parses the command-line arguments and then
-- forks off calls to 'run_twat' for each supplied username. After
-- forking, main loops forever.
main :: IO ()
main = do
  errors <- parse_errors

  -- If there  were errors parsing the command-line options,
  -- print them and exit.
  when (not (null errors)) $ do
      hPutStrLn stderr (concat errors)
      putStrLn help_text
      exitWith (ExitFailure exit_args_parse_failed)

  -- Next, check to see if the 'help' option was passed to the
  -- program. If it was, display the help, and exit successfully.
  help <- help_set
  when (help) $ do
    putStrLn help_text
    exitWith ExitSuccess

  -- Get the list of usernames.
  usernames <- parse_usernames

  -- And a Cfg object.
  cfg <- get_cfg
  
  -- If we have both a "To" and "From" address, we'll create a
  -- message object to be passed to all of our threads.
  let message = construct_message cfg

  -- Execute run_twat on each username in a new thread.
  let run_twat_curried = run_twat cfg message
  _ <- mapM (forkIO . run_twat_curried) usernames

  _ <- forever $ do
    -- This thread (the one executing main) doesn't do anything,
    -- but when it terminates, so do all the threads we forked.
    -- As a result, we need to keep this thread on life support.
    thread_sleep (heartbeat cfg)

  return ()


-- | A debugging tool that will parse, print, and email a single
--   status (given by its id).
twat_single_status :: Integer -> (Maybe Message) -> IO ()
twat_single_status the_status_id maybe_message = do
    xmldata <- get_status the_status_id

    -- Parsing an empty result can blow up. Just pretend there are
    -- no new statuses in that case.
    let statuses = case xmldata of
                     Just xml -> parse_status xml
                     Nothing  -> []

    case (length statuses) of
      0 -> do
        putStrLn "No statuses returned."
        return ()
      _ -> do
        _ <- mapM (putStrLn . pretty_print) statuses

        case maybe_message of
          Nothing -> do
             putStrLn "No message object given."
             return ()
          Just message -> do
             default_date <- rfc822_now
             let messages = map (message_from_status message (default_date)) statuses
             sendmail_results <- mapM sendmail messages
             _ <- mapM print_sendmail_result sendmail_results
             return ()