packages feed

cltw (empty) → 1.1.4

raw patch · 13 files changed

+582/−0 lines, 13 filesdep +basedep +curldep +mtlsetup-changed

Dependencies added: base, curl, mtl, random, tagsoup

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Dino Morelli 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Dino Morelli nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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
+ Setup.hs view
@@ -0,0 +1,29 @@+#! /usr/bin/env runhaskell++-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++import Control.Monad ( unless )+import Distribution.Simple+import System.FilePath+import System.Posix.Files ( createSymbolicLink, fileExist )+++symlinkBinary binary = do+   let dest = "bin" </> binary++   exists <- fileExist dest+   unless exists $ do+      let src = ".." </> "dist" </> "build" </> binary </> binary+      createSymbolicLink src dest+++main = defaultMainWithHooks (simpleUserHooks +   { postBuild = customPostBuild+   } )+   where+      -- Create symlinks in bin to the binaries after build for +      -- developer convenience+      customPostBuild _ _ _ _ = mapM_ symlinkBinary+         [ "cltw" ]
+ TODO view
+ cltw.cabal view
@@ -0,0 +1,22 @@+name:                cltw+version:             1.1.4+cabal-version:       >= 1.2+build-type:          Simple+license:             BSD3+license-file:        LICENSE+copyright:           2010 Dino Morelli+author:              Dino Morelli+maintainer:          Dino Morelli <dino@ui3.info>+stability:           experimental+homepage:            http://ui3.info/d/proj/cltw.html+synopsis:            Command line Twitter utility+description:         A tool for performing some Twitter API functions +                     from the command line.+category:            Console, Utils+tested-with:         GHC>=6.12.1++executable           cltw+   main-is:          main.hs+   hs-source-dirs:   src+   build-depends:    base >= 3 && < 5, curl, mtl, random, tagsoup+   ghc-options:      -Wall
+ doc/dev/notes view
+ src/Cltw/Common.hs view
@@ -0,0 +1,33 @@+-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Cltw.Common+   where++import Control.Monad.Error+import Control.Monad.Reader+import Text.Printf++import Cltw.Opts+++type Cltw a = ErrorT String (ReaderT Options IO) a++runCltw :: Options -> Cltw a -> IO (Either String a)+runCltw env ev = runReaderT (runErrorT ev) env+++apiPrefix :: String+apiPrefix = "api.twitter.com/1/"+++constructUri :: String -> Cltw String+constructUri apiCall = do+   account <- asks optUser+   mbPw <- asks optPassword++   return $ case mbPw of+      Just password -> printf "https://%s:%s@%s%s.xml"+         account password apiPrefix apiCall+      Nothing -> printf "http://%s%s/%s.xml" apiPrefix apiCall account
+ src/Cltw/Opts.hs view
@@ -0,0 +1,139 @@+-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++{-# LANGUAGE FlexibleContexts #-}++module Cltw.Opts+   ( Options (..)+   , parseOpts, usageText+   )+   where++import Control.Monad.Error+import Data.List+import System.Console.GetOpt+++data Options = Options+   { optUser :: String+   , optPassword :: Maybe String+   , optVerbosity :: Int+   , optEchoReqUri :: Bool+   , optAddNoise :: Bool+   }+   deriving Show+++defaultOptions :: Options+defaultOptions = Options+   { optUser = ""+   , optPassword = Nothing+   , optVerbosity = 1+   , optEchoReqUri = False+   , optAddNoise = False+   }+++options :: [OptDescr (Options -> Options)]+options =+   [ Option ['u'] ["user"]+      (ReqArg+         (\u opts -> opts { optUser = u })+         "USER"+      ) "Username (always required)"+   , Option ['p'] ["password"]+      (ReqArg+         (\u opts -> opts { optPassword = Just u })+         "PASSWORD"+      ) "Password for calls requiring authentication"+   , Option ['v'] ["verbosity"]+      (ReqArg (\v opts -> opts { optVerbosity = read v }) "NUM")+      "Verbosity: 0, 1 (default), 2. Higher is more verbose"+   , Option ['e'] ["echo-request-uri"]+      (NoArg (\opts -> opts { optEchoReqUri = True }))+      "Echo the request URI string sent to Twitter"+   , Option ['a'] ["add-noise"]+      (NoArg (\opts -> opts { optAddNoise = True }))+      "Add a 2-character randomly-generated base-36 'noise' string to end of update. Good for repeating yourself, but please exercise restraint"+   ]+++commands :: [String]+commands = ["followers", "friends", "help", "update"]+++disambCommand :: (MonadError String m) => String -> m String+disambCommand i = case (filtCmds i) commands of+   [c] -> return c+   []  -> throwError $ "Unknown command: " ++ i+   cs  -> throwError $ "Ambiguous command, could be one of: " +++      (intercalate " " cs)+   where+      filtCmds = filter . isPrefixOf+++parseOpts :: [String] -> IO (Options, String, [String])+parseOpts argv = do+   result <- runErrorT $ do+      (opts, inputCmd, rest) <- case getOpt Permute options argv of+         (o, (i:r), []  ) ->+            return (foldl (flip id) defaultOptions o, i, r)+         (_, []    , []  ) ->+            throwError $ "No command specified\n\n" ++ usageText+         (_, _     , errs) -> throwError $ concat errs++      command <- disambCommand inputCmd++      when ((optUser opts == "") && (command /= "help")) $+         throwError "MUST specify a Twitter account username"++      return (opts, command, rest)++   either error return result+++usageText :: String+usageText = (usageInfo header options) ++ "\n" ++ footer+   where+      header = init $ unlines+         [ "Usage: cltw COMMAND [OPTIONS] [COMMAND-SPECIFIC DATA]"+         , "Twitter API command-line utility"+         , ""+         , "Commands:"+         , ""+         , "  followers -u USER"+         , "    Show people following you"+         , ""+         , "  friends -u USER"+         , "    Show people whom you are following"+         , "    Verbosity applies to followers/friends output like this:"+         , "      -v 0 -> <screen name>"+         , "      -v 1 -> <screen name>  <name>  <user ID>"+         , ""+         , "  update -u USER -p PASSWORD STATUS_TEXT"+         , "    Post a status update"+         , ""+         , "  help"+         , "    This help text"+         , ""+         , "Options:"+         ]+      footer = init $ unlines+         [ "This is a tool for performing some Twitter API functions from the command line."+         , ""+         , "What kinds of things can you do?"+         , ""+         , "Keep a list of people you are following:"+         , "  $ cltw fr -u stimpy | sort > some/file"+         , ""+         , "Check to see if somebody specific is following you:"+         , "  $ cltw fo -u stimpy | grep somebodyontwitter"+         , ""+         , "Post an update from a script or cron job:"+         , "  $ cltw update -u stimpy -p spumco \"My message to the world\""+         , ""+         , "Don't get crazy with scripts though, Twitter frowns on spam and so do your followers!"+         , ""+         , "Version 1.1.4  Dino Morelli <dino@ui3.info>"+         ]
+ src/Cltw/Update.hs view
@@ -0,0 +1,70 @@+-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++module Cltw.Update+   ( postUpdate+   )+   where++import Control.Monad.Error+import Control.Monad.Reader+import Network.Curl+import System.Random++import Cltw.Common+import Cltw.Opts+++pad :: Int -> String -> String+pad l = reverse . take l . (flip (++) $ repeat '0') . reverse+++base36Encode :: Int -> String+base36Encode = reverse . base36Encode'+   where+      base36Encode' 0 = []+      base36Encode' n = alphabet !! f : base36Encode' w+         where+            (w, f) = n `divMod` 36+            alphabet = "0123456789abcdefghijklmnopqrstuvwxyz"+++postUpdate :: [String] -> Cltw ()++postUpdate (msg:_) = do+   uri <- constructUri "statuses/update"++   echo <- asks optEchoReqUri+   when echo $ liftIO $ putStrLn uri++   addNoise <- asks optAddNoise+   noise <- liftIO $ case addNoise of+         -- The range of ints from 0 to 1295 generate the base36 numbers+         -- 00 to zz+         True -> liftM ((' ' :) . pad 2 . base36Encode)+            $ randomRIO (0, 1295)+         False -> return ""++   let status = msg ++ noise++   when (length status > 140) $+      throwError "Update length is longer than 140 characters"++   mbErr <- liftIO $ withCurlDo $ do+      let curlOpts = [ CurlCookieJar "cookies" ]++      curl <- initialize+      setopts curl curlOpts++      r <- do_curl_ curl uri $ CurlPostFields ["status=" ++ status]+            : method_POST :: IO CurlResponse++      if respCurlCode r /= CurlOK || respStatus r /= 200+         then return . Just . respBody $ r+         else return Nothing++   maybe (return ()) throwError mbErr++postUpdate [] =+   throwError "Posting an update requires a status message"
+ src/Cltw/User.hs view
@@ -0,0 +1,99 @@+-- 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"
+ src/main.hs view
@@ -0,0 +1,39 @@+-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++import Control.Monad.Reader+import System.Environment+import System.Exit++import Cltw.Common+import Cltw.Opts+import Cltw.Update+import Cltw.User+++executeCommand :: String -> [String] -> Cltw ()++executeCommand cmd@"followers" _ = executeUsersCommand cmd++executeCommand cmd@"friends" _ = executeUsersCommand cmd++executeCommand "update" msg = postUpdate msg++-- This only gets invoked for the "help" command, hence the ExitSuccess+executeCommand _ _ = liftIO $ do+   putStrLn usageText+   exitWith ExitSuccess+++errHandler :: String -> IO a+errHandler errMsg = do+   putStrLn errMsg+   exitWith $ ExitFailure 1+++main :: IO ()+main = do+   (opts, cmd, rest) <- getArgs >>= parseOpts+   result <- runCltw opts $ executeCommand cmd rest+   either errHandler return result
+ util/gentags.sh view
@@ -0,0 +1,3 @@+#! /bin/sh++find src -regex '.*\..?hs' | xargs hasktags -c
+ util/prefs/boring view
@@ -0,0 +1,117 @@+# Boring file regexps:++### compiler and interpreter intermediate files+# haskell (ghc) interfaces+\.hi$+\.hi-boot$+\.o-boot$+# object files+\.o$+\.o\.cmd$+# profiling haskell+\.p_hi$+\.p_o$+# haskell program coverage resp. profiling info+\.tix$+\.prof$+# fortran module files+\.mod$+# linux kernel+\.ko\.cmd$+\.mod\.c$+(^|/)\.tmp_versions($|/)+# *.ko files aren't boring by default because they might+# be Korean translations rather than kernel modules+# \.ko$+# python, emacs, java byte code+\.py[co]$+\.elc$+\.class$+# objects and libraries; lo and la are libtool things+\.(obj|a|exe|so|lo|la)$+# compiled zsh configuration files+\.zwc$+# Common LISP output files for CLISP and CMUCL+\.(fas|fasl|sparcf|x86f)$++### build and packaging systems+# cabal intermediates+\.installed-pkg-config+\.setup-config+# standard cabal build dir, might not be boring for everybody+# ^dist(/|$)+# autotools+(^|/)autom4te\.cache($|/)+(^|/)config\.(log|status)$+# microsoft web expression, visual studio metadata directories+\_vti_cnf$+\_vti_pvt$+# gentoo tools+\.revdep-rebuild.*+# generated dependencies+^\.depend$++### version control systems+# cvs+(^|/)CVS($|/)+\.cvsignore$+# cvs, emacs locks+^\.#+# rcs+(^|/)RCS($|/)+,v$+# subversion+(^|/)\.svn($|/)+# mercurial+(^|/)\.hg($|/)+# git+(^|/)\.git($|/)+# bzr+\.bzr$+# sccs+(^|/)SCCS($|/)+# darcs+(^|/)_darcs($|/)+(^|/)\.darcsrepo($|/)+^\.darcs-temp-mail$+-darcs-backup[[:digit:]]+$+# gnu arch+(^|/)(\+|,)+(^|/)vssver\.scc$+\.swp$+(^|/)MT($|/)+(^|/)\{arch\}($|/)+(^|/).arch-ids($|/)+# bitkeeper+(^|/)BitKeeper($|/)+(^|/)ChangeSet($|/)++### miscellaneous+# backup files+~$+\.bak$+\.BAK$+# patch originals and rejects+\.orig$+\.rej$+# X server+\..serverauth.*+# image spam+\#+(^|/)Thumbs\.db$+# vi, emacs tags+(^|/)(tags|TAGS)$+#(^|/)\.[^/]+# core dumps+(^|/|\.)core$+# partial broken files (KIO copy operations)+\.part$+# waf files, see http://code.google.com/p/waf/+(^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/)+(^|/)\.lock-wscript$+# mac os finder+(^|/)\.DS_Store$+# cabal+(^|/)dist($|/)++(^|/)bin($|/)