diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,29 @@ +#! /usr/bin/env runhaskell + +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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" ] diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO diff --git a/cltw.cabal b/cltw.cabal new file mode 100644 --- /dev/null +++ b/cltw.cabal @@ -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 +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 diff --git a/doc/dev/notes b/doc/dev/notes new file mode 100644 --- /dev/null +++ b/doc/dev/notes diff --git a/src/Cltw/Common.hs b/src/Cltw/Common.hs new file mode 100644 --- /dev/null +++ b/src/Cltw/Common.hs @@ -0,0 +1,33 @@ +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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 diff --git a/src/Cltw/Opts.hs b/src/Cltw/Opts.hs new file mode 100644 --- /dev/null +++ b/src/Cltw/Opts.hs @@ -0,0 +1,139 @@ +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# 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 -> " + , " -v 1 -> " + , "" + , " 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 " + ] diff --git a/src/Cltw/Update.hs b/src/Cltw/Update.hs new file mode 100644 --- /dev/null +++ b/src/Cltw/Update.hs @@ -0,0 +1,70 @@ +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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" diff --git a/src/Cltw/User.hs b/src/Cltw/User.hs new file mode 100644 --- /dev/null +++ b/src/Cltw/User.hs @@ -0,0 +1,99 @@ +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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 (~== "") + + +extractCursor :: [Tag String] -> String +extractCursor = fromTagText . head . filter isTagText + . head . sections (~== "") + + +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" diff --git a/src/main.hs b/src/main.hs new file mode 100644 --- /dev/null +++ b/src/main.hs @@ -0,0 +1,39 @@ +-- Copyright: 2010 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +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 diff --git a/util/gentags.sh b/util/gentags.sh new file mode 100644 --- /dev/null +++ b/util/gentags.sh @@ -0,0 +1,3 @@ +#! /bin/sh + +find src -regex '.*\..?hs' | xargs hasktags -c diff --git a/util/prefs/boring b/util/prefs/boring new file mode 100644 --- /dev/null +++ b/util/prefs/boring @@ -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($|/)