twitter-0.1: Twitter.hs

module Main where

import GUI.Terminal
import Twitter.Client hiding (getTweets)
import qualified Twitter.Client as Client
import Control.Monad.State
import Commands
import State
import System.Console.Readline hiding (message)
import System.IO
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import System.Directory (getHomeDirectory, doesFileExist)
import System.FilePath (combine)

initialState :: AppState
initialState = AppState [] 0 0 (80,25) NormalMode ""

main = do
  g <- geometry
  homeDir <- getHomeDirectory
  let filename = combine homeDir ".twitter"
  exists <- doesFileExist filename
  if not exists
     then showAuthError
     else do authorization <- readFile filename
             s <- refresh $ initialState {geom = g, auth = takeWhile (/= '\n') authorization}
             hSetBuffering stdin NoBuffering
             mainLoop s

showAuthError = putStrLn "Please create a file in your home-directory called .twitter with the contents username:password"

mainLoop :: AppState -> IO ()
mainLoop initState = do
  let (output, state) = runState drawScreen initState
      (width, height) = geom state
  putStrLn output
  putStr $ move 0 height
  putStr hideCursor
  case mode state of
       NormalMode  -> do let tweet = activeTweet state
                         putStr $ intercalate " | " $ [ show $ time tweet
                                                      , "@" ++ (screenName . user) tweet
                                                      ] ++ maybeToList (url $ user tweet)
  
                         putStr $ move 0 (height)
                         input <- getChar
                         processChar input state
       InsertMode  -> do putStr showCursor
                         input <- readline "say: "
                         processInsert input state
       CommandMode -> do putStr showCursor
                         input <- readline ":"
                         processCommand input state

drawScreen :: State AppState String
drawScreen = do
  tweets' <- getTweets
  let tweets = zip tweets' [0..]
  formattedTweets <- mapM formatTweet tweets
  return $ clear ++ header ++ unlines formattedTweets

header = []

quit = putStr (clear ++ showCursor ++ color Reset)

formatTweet (tweet, idx) = 
  do
    activeIdx <- getActiveTweet
    let
      name' = (name . user) tweet
      msg  = message tweet
      time' = time tweet
      active = activeIdx == idx
      (start_active, end_active) | active = (color Blue_bg, color Reset_bg)
                                 | otherwise = ([], [])
    return $ start_active ++ color Cyan_b ++ name' ++ color Reset_b 
             ++ ": " ++ msg ++ end_active

processCommand (Just "q") state = quit
processCommand _ state = mainLoop (normal state)

normal state = state {mode=NormalMode}

processInsert Nothing state = mainLoop $ normal state
processInsert (Just "") state = mainLoop $ normal state
processInsert (Just input) state = do
  when (length input > 140) $ do
    putStrLn "Your input exceeds 140 characters."
    getChar >> return ()

  addHistory input
  say (auth state) input
  state' <- refresh state
  mainLoop $ normal state'

processChar input state = 
  case charToCmd input of
       Up      -> mod $ modifyActiveTweet (\x -> x - 1)
       Down    -> mod $ modifyActiveTweet (+1) 
       Reply   -> putStrLn "TODO" >> getLine >> mainLoop state
       First   -> mod $ setActiveTweet 0
       Last    -> mod $ do tw <- getTweets
                           setActiveTweet (length tw - 1)
       Refresh -> refresh state >>= mainLoop
       Unknown -> mainLoop state
       Insert  -> mod $ setMode InsertMode
       Command -> mod $ setMode CommandMode
   where mod f = mainLoop $ execState f state

refresh :: AppState -> IO AppState
refresh s = do maybeTw <- Client.getTweets (auth s)
               case maybeTw of
                    Just tw -> return $ s {tweets = tw}
                    _       -> return s


activeTweet state = tweets state !! (active_tweet state)