packages feed

twitter (empty) → 0.1

raw patch · 9 files changed

+396/−0 lines, 9 filesdep +basedep +curldep +directorysetup-changed

Dependencies added: base, curl, directory, filepath, json, mtl, old-locale, readline, time, xml

Files

+ Commands.hs view
@@ -0,0 +1,14 @@+module Commands where++data Command = Down | Up | Refresh | Reply | First | Last | Unknown +             | Insert | Command++charToCmd 'i' = Insert+charToCmd 'j' = Down+charToCmd 'k' = Up+charToCmd 'r' = Reply+charToCmd 'R' = Refresh+charToCmd 'g' = First+charToCmd 'G' = Last+charToCmd ':' = Command+charToCmd  _  = Unknown
+ Gui/Terminal.hs view
@@ -0,0 +1,120 @@+-- Copied from the Nethask project+module GUI.Terminal (+    move, move_up, move_down, move_forward, move_back+  , clr, clear, clear_eol, reset, blinkRed, big, Color (..), color, geometry+  , hideCursor, showCursor+  ) where++import Control.Monad (liftM, liftM2)+import Data.List (intercalate)+import System.Environment (getEnvironment)++--------[ ansi escape sequence generation ]------------------------------------++-- Generic function for producing ANSI escape sequences.+esc :: String -> String -> [String] -> String+esc a b arg = concat ["\ESC[", a, intercalate ";" $ arg, b]++-- Move the cursor to the specified row and column.+move col row = esc "" "H" [show row, show col]++showCursor = esc "" "l" ["25"]+hideCursor = esc "" "l" ["25"]++move_up      rows = esc "" "A" [show rows]+move_down    rows = esc "" "B" [show rows]+move_back    rows = esc "" "D" [show rows]+move_forward rows = esc "" "C" [show rows]++-- Load and store the current cursor position.+save = esc "s" "" []+load = esc "u" "" []++-- Generic function for creating (forground) color sequences.+clr attr fg = esc "" "m" [attr, fg]++-- Clear screen and end-of-line+clear     = esc "2J" "" [] ++ move 1 1+clear_eol = esc "K"  "" []++reset = clear ++ color Reset++blinkRed = esc "" "m" ["1", "5", "31"]++big s =+     "\ESC#3" ++ s+  ++ move_back (length s)+  ++ move_down 1+  ++ "\ESC#4" ++ s ++ "\n"++--------[ ansi color listing ]-------------------------------------------------++data Color =+    Black   | Black_b   | Black_bl   | Black_bg+  | Red     | Red_b     | Red_bl     | Red_bg+  | Green   | Green_b   | Green_bl   | Green_bg+  | Yellow  | Yellow_b  | Yellow_bl  | Yellow_bg+  | Blue    | Blue_b    | Blue_bl    | Blue_bg+  | Magenta | Magenta_b | Magenta_bl | Magenta_bg+  | Cyan    | Cyan_b    | Cyan_bl    | Cyan_bg+  | White   | White_b   | White_bl   | White_bg+  | Reset   | Reset_b   | Reset_bl   | Reset_bg+  deriving (Show, Eq)++-- List of foreground color sequences.+color Black      = clr "0" "30"+color Red        = clr "0" "31"+color Green      = clr "0" "32"+color Yellow     = clr "0" "33"+color Blue       = clr "0" "34"+color Magenta    = clr "0" "35"+color Cyan       = clr "0" "36"+color White      = clr "0" "37"+color Reset      = clr "0" "39"++-- List of bold foreground color sequences.+color Black_b    = clr "1" "30"+color Red_b      = clr "1" "31"+color Green_b    = clr "1" "32"+color Yellow_b   = clr "1" "33"+color Blue_b     = clr "1" "34"+color Magenta_b  = clr "1" "35"+color Cyan_b     = clr "1" "36"+color White_b    = clr "1" "37"+color Reset_b    = clr "1" "39"++-- List of background color sequences.+color Black_bg   = clr "1" "40"+color Red_bg     = clr "1" "41"+color Green_bg   = clr "1" "42"+color Yellow_bg  = clr "1" "43"+color Blue_bg    = clr "1" "44"+color Magenta_bg = clr "1" "45"+color Cyan_bg    = clr "1" "46"+color White_bg   = clr "1" "47"+color Reset_bg   = clr "1" "49"++-- List of background color sequences.+color Black_bl   = esc "" "m" ["5", "30"]+color Red_bl     = esc "" "m" ["5", "31"]+color Green_bl   = esc "" "m" ["5", "32"]+color Yellow_bl  = esc "" "m" ["5", "33"]+color Blue_bl    = esc "" "m" ["5", "34"]+color Magenta_bl = esc "" "m" ["5", "35"]+color Cyan_bl    = esc "" "m" ["5", "36"]+color White_bl   = esc "" "m" ["5", "37"]+color Reset_bl   = esc "" "m" ["5", "39"]++--------[ terminal geometry ]--------------------------------------------------++-- Try to read terminal width from environment variable.+width :: IO Int+width = liftM (maybe 80 read . lookup "COLUMNS") getEnvironment++-- Try to read terminal height from environment variable.+height :: IO Int+height = liftM (maybe 24 read . lookup "LINES") getEnvironment++-- Try to read terminal width and height from environment variables.+geometry :: IO (Int, Int)+geometry = liftM2 (,) width height
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2008 Tupil++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,10 @@+Create a file ~/.twitter and run the program.++Commands:+  i = Insert+  j = Down+  k = Up+  R = Refresh+  g = Select first message+  G = Select last message+  :q quits
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ State.hs view
@@ -0,0 +1,32 @@+module State where+import Control.Monad.State+import Twitter.Client (Tweet)++data Mode = NormalMode | InsertMode | CommandMode+data AppState = AppState { tweets :: [Tweet]+                         , active_tweet :: Int+                         , scroll :: Int+                         , geom :: (Int, Int)+                         , mode :: Mode+                         , auth :: String+                   }++getActiveTweet :: State AppState Int+getActiveTweet = get >>= return . active_tweet+setActiveTweet x = modifyActiveTweet (const x)+modifyActiveTweet f = do st <- get +                         tweets <- getTweets+                         let at' = f (active_tweet st)+                             newAt = max 0 (min at' $ length tweets - 1)+                         put $ st {active_tweet = newAt}++getTweets :: State AppState [Tweet]+getTweets = get >>= return . tweets++getAuth :: State AppState String+getAuth = get >>= return . auth+++setMode x = modifyMode (const x)+modifyMode f = do st <- get +                  put $ st {mode = f (mode st)}
+ Twitter.hs view
@@ -0,0 +1,118 @@+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)
+ Twitter/Client.hs view
@@ -0,0 +1,57 @@+module Twitter.Client where++import Network.Curl+import Text.JSON+import Text.JSON.String+import Data.Time.Format+import Data.Time.Clock+import Data.Time.LocalTime+import System.Locale+import Data.Maybe (fromJust)++timeline_url = "http://twitter.com/statuses/friends_timeline.json"+post_url = "http://twitter.com/statuses/update.xml"+options auth = [CurlUserPwd auth, CurlVerbose False]++data Tweet = Tweet { user    :: TwitterUser+                   , message :: String+                   , time    :: LocalTime+                   }+ deriving Show+data TwitterUser = TwitterUser {name :: String, screenName :: String, url :: Maybe String}+ deriving Show++getTweets :: String -> IO (Maybe [Tweet])+getTweets auth = do+  (code, feed) <- curlGetString timeline_url (options auth)+  tz <- getCurrentTimeZone+  return $ case runGetJSON readJSArray feed of+      (Right (JSArray tweets')) -> Just $ map (processTweet tz) tweets'+      _                         -> Nothing++processTweet tz (JSObject o) = Tweet user msg time+ where+  user   = parseUser $ "user" `lookup` obj+  time   = pTime tz $ cleanString "created_at" obj+  msg    = cleanString "text" obj+  obj    = fromJSObject o++pTime :: TimeZone -> String -> LocalTime+pTime tz s = utcToLocalTime tz $ fromJust $ parseTime defaultTimeLocale "%c" s+  +parseUser (Just (JSObject o)) = TwitterUser name screenName url+ where name       = cleanString       "name" obj+       screenName = cleanString       "screen_name" obj+       url        = cleanMaybeString  "url" obj+       obj = fromJSObject o++cleanString s obj = fromJSString msg+ where (Just (JSString msg)) = s `lookup` obj++cleanMaybeString s obj = + case s `lookup` obj of+   (Just (JSString msg)) -> Just $ fromJSString msg+   _ -> Nothing++say :: String -> String -> IO ()+say auth msg = curlMultiPost post_url (options auth) [multiformString "status" msg]
+ twitter.cabal view
@@ -0,0 +1,16 @@+Name:                twitter+Version:             0.1+Synopsis:            A Haskell-based CLI Twitter client+Description:         A really basic twitter client. +License:             BSD3+License-file:        LICENSE+Author:              Chris Eidhof+Maintainer:          Chris Eidhof <ce@tupil.com>+Build-Depends:       base, filepath, curl, directory, xml, readline, old-locale, +                     time, json, mtl+build-type:          Simple+category:            Network++Executable:          twitter+Main-is:             Twitter.hs+