twidge 0.99.3 → 1.0.0
raw patch · 12 files changed
+675/−253 lines, 12 filesdep +Bitlydep +binarydep +bytestringdep ~base
Dependencies added: Bitly, binary, bytestring, curl, hoauth
Dependency ranges changed: base
Files
- Commands.hs +10/−4
- Commands/Follow.hs +0/−60
- Commands/FollowBlock.hs +64/−0
- Commands/Ls.hs +179/−71
- Commands/Setup.hs +93/−27
- Commands/Update.hs +58/−8
- Config.hs +11/−4
- Download.hs +43/−30
- doc/twidge-manpage.sgml +148/−30
- twidge.bash_completion +31/−0
- twidge.cabal +24/−11
- twidge.hs +14/−8
Commands.hs view
@@ -18,7 +18,7 @@ {- | Module : Commands- Copyright : Copyright (C) 2006-2008 John Goerzen+ Copyright : Copyright (C) 2006-2010 John Goerzen License : GNU GPL, version 2 or above Maintainer : John Goerzen <jgoerzen@complete.org>@@ -35,7 +35,7 @@ import Types import Config -import qualified Commands.Follow+import qualified Commands.FollowBlock import qualified Commands.Ls import qualified Commands.Setup import qualified Commands.Update@@ -43,17 +43,23 @@ --allCommands :: [(String, Command)] allCommands = [Commands.Update.dmsend,- Commands.Follow.follow,+ Commands.FollowBlock.block,+ Commands.FollowBlock.follow, Commands.Ls.lsarchive, lscommands, Commands.Ls.lsdm, Commands.Ls.lsdmarchive,+ Commands.Ls.lsblocking, Commands.Ls.lsfollowers, Commands.Ls.lsfollowing, Commands.Ls.lsrecent, Commands.Ls.lsreplies,+ Commands.Ls.lsrt,+ Commands.Ls.lsrtarchive,+ Commands.Ls.lsrtreplies, Commands.Setup.setup,- Commands.Follow.unfollow,+ Commands.FollowBlock.unblock,+ Commands.FollowBlock.unfollow, Commands.Update.update ]
− Commands/Follow.hs
@@ -1,60 +0,0 @@-{--Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--module Commands.Follow(follow, unfollow) where-import Utils-import System.Log.Logger-import Data.List-import Download--i = infoM "follow"--follow = simpleCmd "follow" "Start following someone"- follow_help- [] follow_worker--follow_worker _ cp ([], [user]) =- do xmlstr <- sendAuthRequest cp ("/friendships/create/" ++ user ++ ".xml") [] [("id", user)]- debugM "follow" $ "Got doc: " ++ xmlstr- -- let doc = getContent . xmlParse "follow" . stripUnicodeBOM $ xmlstr- -- return ()- -follow_worker _ _ _ =- permFail "follow: syntax error; see twidge follow --help"--follow_help =- "Usage: twidge follow username\n\n\- \will add username to your list of people you follow.\n\n"---unfollow = simpleCmd "unfollow" "Stop following someone"- unfollow_help- [] unfollow_worker--unfollow_worker _ cp ([], [user]) =- do xmlstr <- sendAuthRequest cp ("/friendships/destroy/" ++ user ++ ".xml") [] [("id", user)]- debugM "unfollow" $ "Got doc: " ++ xmlstr- -- let doc = getContent . xmlParse "follow" . stripUnicodeBOM $ xmlstr- -- return ()--unfollow_worker _ _ _ =- permFail "unfollow: syntax error; see twidge unfollow --help"--unfollow_help =- "Usage: twidge unfollow username\n\n\- \will remove username from the list of people you follow.\n"
+ Commands/FollowBlock.hs view
@@ -0,0 +1,64 @@+{-+Copyright (C) 2006-2009 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Commands.FollowBlock(follow, unfollow, block, unblock) where+import Utils+import System.Log.Logger+import Data.List+import Download++i = infoM "followblock"++follow = simpleCmd "follow" "Start following someone"+ follow_help+ [] follow_worker+follow_worker = generic_worker "/friendships/create/" "follow"+follow_help = generic_add_help "follow"++unfollow = simpleCmd "unfollow" "Stop following someone"+ unfollow_help+ [] unfollow_worker+unfollow_worker = generic_worker "/friendships/destroy/" "unfollow"+unfollow_help = generic_rm_help "follow"++block = simpleCmd "block" "Start blocking someone"+ block_help [] block_worker+block_worker = generic_worker "/blocks/create/" "block"+block_help = generic_add_help "block"++unblock = simpleCmd "unblock" "Stop blocking someone"+ unblock_help [] unblock_worker+unblock_worker = generic_worker "/blocks/destroy/" "unblock"+unblock_help = generic_rm_help "block"++generic_worker urlbase cmdname _ cp ([], [user]) =+ do xmlstr <- sendAuthRequest cp (urlbase ++ user ++ ".xml") [] [("id", user)]+ debugM cmdname $ "Got doc: " ++ xmlstr+ -- let doc = getContent . xmlParse "follow" . stripUnicodeBOM $ xmlstr+ -- return ()+ +generic_worker _ cmdname _ _ _ =+ permFail $ "follow: syntax error; see twidge " ++ cmdname ++ " --help"++generic_add_help cmd = + "Usage: twidge " ++ cmd ++ " username\n\n\+ \will add username to your list of people you " ++ cmd ++ ".\n\n"++generic_rm_help cmd =+ "Usage: twidge un" ++ cmd ++ " username\n\n\+ \will remove username from the list of people you " ++ cmd ++ ".\n"
Commands/Ls.hs view
@@ -16,7 +16,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -module Commands.Ls(lsrecent, lsreplies, lsfollowing, lsfollowers, lsarchive, lsdm, lsdmarchive) where+module Commands.Ls(lsrecent, lsreplies, lsblocking,+ lsfollowing, lsfollowers, lsarchive, + lsrt, lsrtreplies, lsrtarchive, lsdm, lsdmarchive) where import Utils import System.Log.Logger import Types@@ -33,17 +35,24 @@ import Control.Monad(when) import HSH import System.Console.GetOpt.Utils-import qualified System.IO.UTF8 as UTF8+import Network.URI+import Data.Maybe (isJust) i = infoM "ls" +defaultWidth = 80+ stdopts = [Option "a" ["all"] (NoArg ("a", "")) "Show ALL results, not just 1st page\n\ \WARNING: may generate excessive traffic. \ \Use with caution!", Option "l" ["long"] (NoArg ("l", "")) "Long format output -- more info and \- \tab-separated columns"]+ \tab-separated columns",+ Option "w" ["width"] (ReqArg (stdRequired "w") "WIDTH")+ ("Set the margin at which word-wrapping occurs.\n\+ \Ignored in long format mode. Default is "+ ++ show defaultWidth ++ ".")] sinceopts = [ Option "e" ["exec"] (ReqArg (stdRequired "e") "COMMAND")@@ -62,17 +71,6 @@ Option "u" ["unseen"] (NoArg ("u", "")) "Show only items since the last use of --saveid"] -paginated workerfunc cppath cp (args, remainder)- | lookup "a" args == Nothing = - do workerfunc cppath cp (args, remainder) 1- return ()- | otherwise = paginateloop 1- where paginateloop page =- do r <- workerfunc cppath cp (args, remainder) page- if null r- then return ()- else paginateloop (page + 1)- maybeSaveList section cpath cp args [] = return () maybeSaveList section cpath cp args newids = do debugM section $ "maybeSaveList called for " ++ section ++ ": " @@ -81,12 +79,14 @@ where theid = maximum . map (read::String -> Integer) $ newids maybeSave section cpath cp args newid =- case (lookup "s" args, get cp section "lastid") of- (Nothing, _) -> do debugM "maybeSave" "maybeSave: No -s in args"- return ()- (_, Left _) -> do debugM "maybeSave" "maybeSave: Will add ID"- saveid- (_, Right x) ->+ let sArg = isJust $ lookup "s" args+ sConf = isRight True $ get cp "DEFAULT" "savelast"+ in case (any id [sArg,sConf], get cp section "lastid") of+ (False, _) -> do debugM "maybeSave" "maybeSave: No -s nor savelast"+ return ()+ (True, Left _) -> do debugM "maybeSave" "maybeSave: Will add ID"+ saveid+ (True, Right x) -> if (read x) > (newid::Integer) then return () else saveid@@ -97,6 +97,8 @@ else add_section cp section cp2 <- set cp2 section "lastid" (show newid) return cp2+ isRight _ (Left _) = False+ isRight v1 (Right v2) = v1 == v2 sinceArgs section cp args = case (lookup "u" args, get cp section "lastid") of@@ -105,8 +107,13 @@ (_, Right a) -> [("since_id", strip a)] +screenNameArgs args =+ case lookup "U" args of+ Nothing -> []+ Just username -> [("screen_name", username)]+ ----------------------------------------------------- lsrecent+-- lsrecent & friends -------------------------------------------------- lsrecent = simpleCmd "lsrecent" "List recent updates from those you follow"@@ -121,9 +128,19 @@ lsarchive = simpleCmd "lsarchive" "List recent status updates you posted yourself" lsarchive_help- (stdopts ++ sinceopts) (paginated (statuses_worker "lsarchive"- "/statuses/user_timeline"))+ (stdopts ++ sinceopts ++ usernameopts) + (paginated (statuses_worker "lsarchive"+ "/statuses/user_timeline"))+ where + usernameopts = [+ Option "U" ["username"] (ReqArg (stdRequired "U") "USERNAME")+ "Instead of showing your own updates, show\n\+ \those of the given username."+ ] +++ lsdm = simpleCmd "lsdm" "List recent direct messages to you" lsdm_help (stdopts ++ sinceopts) (paginated (dm_worker "lsdm" @@ -134,12 +151,28 @@ (stdopts ++ sinceopts) (paginated (dm_worker "lsdmarchive" "/direct_messages/sent")) +lsrt = simpleCmd "lsrt" "List recent retweets from those you follow"+ lsrt_help+ (stdopts ++ sinceopts) (paginated (statuses_worker "lsrt"+ "/statuses/retweeted_to_me"))+ +lsrtarchive = simpleCmd "lsrtarchive" "List recent retweets you made yourself"+ lsrtarchive_help+ (stdopts ++ sinceopts) (paginated (statuses_worker "lsrtarchive"+ "/statuses/retweeted_by_me"))++lsrtreplies = simpleCmd "lsrtreplies" "List others' retweets of your statuses"+ lsrtreplies_help+ (stdopts ++ sinceopts) (paginated (statuses_worker "lsrtreplies"+ "/statuses/retweets_of_me"))+ statuses_worker = generic_worker handleStatus dm_worker = generic_worker handleDM generic_worker procfunc section command cpath cp (args, _) page = do xmlstr <- sendAuthRequest cp (command ++ ".xml")- (("page", show page) : sinceArgs section cp args)+ (("page", show page) : sinceArgs section cp args+ ++ screenNameArgs args) [] debugM section $ "Got doc: " ++ xmlstr results <- procfunc section cp args xmlstr@@ -174,6 +207,31 @@ \refer to the examples under twidge lsrecent --help, which also pertain\n\ \to lsarchive.\n" +lsrt_help = + "Usage: twidge lsrt [options]\n\n\+ \You can see the 20 most recent retweets posted by those you follow with:\n\n\+ \ twidge lsrt\n\n\+ \For more examples, including how to see only unseen retweets, please\n\+ \refer to the examples under twidge lsrecent --help, which also pertain\n\+ \to lsreplies.\n"+ +lsrtreplies_help = + "Usage: twidge lsrtreplies [options]\n\n\+ \You can see the 20 most retweets made of your statuses with:\n\n\+ \ twidge lsrtreplies\n\n\+ \For more examples, including how to see only unseen retweets, please\n\+ \refer to the examples under twidge lsrecent --help, which also pertain\n\+ \to lsreplies.\n"++lsrtarchive_help = + "Usage: twidge lsrt [options]\n\n\+ \You can see the 20 most recent retweets you made:\n\n\+ \ twidge lsrtarchive\n\n\+ \For more examples, including how to see only unseen retweets, please\n\+ \refer to the examples under twidge lsrecent --help, which also pertain\n\+ \to lsreplies.\n"++ lsdm_help = "Usage: twidge lsdm [options]\n\n\ \You can see the 20 most recent direct messages to you with:\n\n\@@ -204,7 +262,7 @@ Message {sId = s (tag "id") item, sSender = s (tag "user" /> tag "screen_name") item, sRecipient = "",- sText = s (tag "text") item,+ sText = unEsc $ s (tag "text") item, sDate = s (tag "created_at") item} s f item = sanitize $ contentToString (keep /> f /> txt $ item)@@ -214,7 +272,7 @@ Message {sId = s (tag "id") item, sSender = s (tag "sender_screen_name") item, sRecipient = s (tag "recipient_screen_name") item,- sText = s (tag "text") item,+ sText = unEsc $ s (tag "text") item, sDate = s (tag "created_at") item} getStatuses = tag "statuses" /> tag "status"@@ -223,20 +281,20 @@ longStatus :: Message -> String longStatus m = printf "%s\t%s\t%s\t%s\t%s\t\n" (sId m) (sSender m) (sRecipient m) (sText m) (sDate m)-shortStatus :: Message -> String-shortStatus m = +shortStatus :: Int -> Message -> String+shortStatus width m = (printf "%-22s %s\n" ("<" ++ sSender m ++ ">") (head wrappedtext)) ++ concatMap (printf "%-22s %s\n" "") (tail wrappedtext)- where wrappedtext = map unwords $ wrapLine (80 - 22 - 2) (words (sText m))+ where wrappedtext = map unwords $ wrapLine (width - 22 - 2) (words (sText m)) -shortDM :: Message -> String-shortDM m =+shortDM :: Int -> Message -> String+shortDM width m = (printf "%-22s %-22s %s\n" ("<" ++ sSender m ++ ">") ("<" ++ sRecipient m ++ ">") (head wrappedtext)) ++ concatMap (printf "%-22s %-22s %s\n" "" "") (tail wrappedtext)- where wrappedtext = map unwords $ wrapLine (80 - 22 - 22 - 3) (words (sText m))+ where wrappedtext = map unwords $ wrapLine (width - 22 - 22 - 3) (words (sText m)) printStatus section cp args m = printGeneric shortStatus longStatus section cp args m@@ -251,8 +309,10 @@ (Just cmd, _) -> runIO $ (cmd, [sId m, sSender m, sRecipient m, sText m, sDate m])- (Nothing, Nothing) -> UTF8.putStr (shortfunc m)- (Nothing, Just _) -> UTF8.putStr (longfunc m)+ (Nothing, Nothing) -> putStr (shortfunc (case lookup "w" args of + Just ws -> read ws+ Nothing -> defaultWidth) m)+ (Nothing, Just _) -> putStr (longfunc m) Just recipient -> mailto section cp args m recipient where msgid = genMsgId section m cp @@ -278,8 +338,21 @@ "", sText m, "",- "(from " ++ sSender m ++ ")"]+ "(from " ++ sSender m ++ ")"+ ,""+ ,"Tweet URL: http://twitter.com/" ++ sSender m +++ "/status/" ++ sId m+ ,"Reply URL: http://twitter.com/home?status=@" +++ escapeURIString isUnreserved (sSender m ++ " ") +++ "&in_reply_to_status_id=" ++ sId m ++ "&in_reply_to=" +++ escapeURIString isUnreserved (sSender m)+ ,"User home: http://twitter.com/" ++ sSender m+ ] +----------------------------------------------------------------------+-- Follow/block type commands+----------------------------------------------------------------------+ -------------------------------------------------- -- lsfollowing --------------------------------------------------@@ -287,32 +360,7 @@ lsfollowing = simpleCmd "lsfollowing" "List people you are following" lsfollowing_help stdopts (paginated lsfollowing_worker)--lsfollowing_worker _ cp (args, user) page =- do xmlstr <- sendAuthRequest cp url [("page", show page)] []- debugM "lsfollowing" $ "Got doc: " ++ xmlstr- let doc = getContent . xmlParse "lsfollowing" . stripUnicodeBOM $ xmlstr- let users = map procUsers . getUsers $ doc- mapM_ (printUser args) users- return users- - where url = case user of- [] -> "/statuses/friends.xml"- [x] -> "/statuses/friends/" ++ x ++ ".xml"- _ -> error "Invalid args to lsfollowing; see twidge lsfollowing --help"--printUser args (name, userid) = - case lookup "l" args of- Nothing -> putStrLn name- Just _ -> printf "%s\t%s\n" userid name--getUsers = tag "users" /> tag "user"--procUsers :: Content -> (String, String)-procUsers item =- (sanitize $ contentToString (keep /> tag "screen_name" /> txt $ item),- sanitize $ contentToString (keep /> tag "id" /> txt $ item))-+lsfollowing_worker = genericfb_worker "lsfollowing" "/statuses/friends" lsfollowing_help = "Usage: twidge lsfollowing [options] [username]\n\n\ \If username is given, list the twitter accounts that user is following.\n\@@ -325,21 +373,81 @@ lsfollowers = simpleCmd "lsfollowers" "List people that follow you" lsfollowers_help stdopts (paginated lsfollowers_worker)+lsfollowers_worker = genericfb_worker "lsfollowers" "/statuses/followers"+lsfollowers_help =+ "Usage: twidge lsfollowers [options] [username]\n\n\+ \If username is given, list the twitter accounts that follow the user.\n\+ \Otherwise, list the twitter accounts that follow you.\n" -lsfollowers_worker _ cp (args, user) page =+--------------------------------------------------+-- lsblocking+--------------------------------------------------++lsblocking = simpleCmd "lsblocking" "List people you are blocking"+ lsblocking_help+ stdopts (paginated lsblocking_worker)+lsblocking_worker = genericfb_worker "lsblocking" "/blocks/blocking"+lsblocking_help =+ "Usage: twidge lsblocking [options]\n\n\+ \List the twitter accounts that your account is blocking.\n"++------------------------------------------------------------+-- Generic follow/block support+-- urlbase should be "/statuses/followers" or "/statuses/friends"+------------------------------------------------------------++genericfb_worker cmdname urlbase _ cp (args, user) page = do xmlstr <- sendAuthRequest cp url [("page", show page)] []- debugM "lsfollowers" $ "Got doc: " ++ xmlstr- let doc = getContent . xmlParse "lsfollowers" . stripUnicodeBOM $ xmlstr+ debugM cmdname $ "Got doc: " ++ xmlstr+ let doc = getContent . xmlParse cmdname . stripUnicodeBOM $ xmlstr let users = map procUsers . getUsers $ doc mapM_ (printUser args) users return users where url = case user of- [] -> "/statuses/followers.xml"- [x] -> "/statuses/followers/" ++ x ++ ".xml"- _ -> error "Invalid args to lsfollowers; see twidge lsfollowers --help"+ [] -> urlbase ++ ".xml"+ [x] -> urlbase ++ "/" ++ x ++ ".xml"+ _ -> error $ "Invalid args to " ++ cmdname ++ + "; see twidge " ++ cmdname ++ " --help"+ printUser args (name, userid) = + case lookup "l" args of+ Nothing -> putStrLn name+ Just _ -> printf "%s\t%s\n" userid name -lsfollowers_help =- "Usage: twidge lsfollowers [options] [username]\n\n\- \If username is given, list the twitter accounts that follow the user.\n\- \Otherwise, list the twitter accounts that follow you.\n"+ getUsers = tag "users" /> tag "user"++ procUsers :: Content -> (String, String)+ procUsers item =+ (sanitize $ contentToString (keep /> tag "screen_name" /> txt $ item),+ sanitize $ contentToString (keep /> tag "id" /> txt $ item))++----------------------------------------------------------------------+-- Generic Utilities+----------------------------------------------------------------------++{- | Calls the workerfunc once if --all wasn't given, to load page 1.++Otherwise, calls workerfunc repeatedly to load all pages, one after another, as+long as it continues to return data.++Used to wrap around worker functions where multiple pages of data can be+returned. -}+paginated workerfunc cppath cp (args, remainder)+ | lookup "a" args == Nothing = + do workerfunc cppath cp (args, remainder) 1+ return ()+ | otherwise = paginateloop 1+ where paginateloop page =+ do r <- workerfunc cppath cp (args, remainder) page+ if null r+ then return ()+ else paginateloop (page + 1)++{- | Twitter has an additional level of escaping for < and > only. +Sigh. -}+unEsc :: String -> String+unEsc [] = []+unEsc x + | "<" `isPrefixOf` x = '<' : unEsc (drop 4 x)+ | ">" `isPrefixOf` x = '>' : unEsc (drop 4 x)+ | otherwise = head x : unEsc (tail x)
Commands/Setup.hs view
@@ -1,5 +1,5 @@ {--Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2010 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -26,50 +26,116 @@ import Data.Char import Config import Control.Monad(when)+import Network.OAuth.Consumer+import Data.Maybe+import Network.OAuth.Http.Request+import Network.OAuth.Http.HttpClient+import OAuth+import Data.Binary(encode)+import Control.Monad.Trans+import qualified Control.Monad.State.Class as M i = infoM "setup"+d = debugM "setup" ----------------------------------------------------- lscasts+-- setup -------------------------------------------------- setup = simpleCmd "setup" "Interactively configure twidge for first-time use"- setup_help- [] setup_worker+ setup_help+ [] setup_worker setup_worker cpath cp _ =- do when (has_option cp "DEFAULT" "username" || - has_option cp "DEFAULT" "password")- (confirmSetup)- hSetBuffering stdout NoBuffering- putStrLn "\nWelcome to twidge. We will now configure twidge for your"- putStrLn "use. This will be quick and easy!\n"- putStrLn "First, what is your usename?\n"- putStr "Username: "- username <- getLine- putStrLn $ "\nWelcome, " ++ username ++ "! Now I'll need your password.\n"- putStr "Password: "- hSetEcho stdin False- password <- getLine- hSetEcho stdin True- let newcp = forceEither $ set cp "DEFAULT" "username" (esc username)- let newcp' = forceEither $ set newcp "DEFAULT" "password" (esc password)- - writeCP cpath newcp'+ do hSetBuffering stdout NoBuffering+ when (has_option cp "DEFAULT" "oauthdata")+ confirmSetup+ putStrLn "\nWelcome to twidge. We will now configure twidge for your"+ putStrLn "use with Twitter (or a similar service). This will be quick and easy!\n"+ putStrLn "\nPlease wait a moment while I query the server...\n\n" - putStrLn "\n\ntwidge has now been configured for you.\n"+ app <- case getApp cp of+ Nothing -> fail $ "Error: must specify oauthconsumerkey and oauthconsumersecret for non-default host " ++ (serverHost cp)+ Just x -> return x+ + let reqUrlBase = forceEither $ get cp "DEFAULT" "oauthrequesttoken"+ let accUrlBase = forceEither $ get cp "DEFAULT" "oauthaccesstoken"+ let authUrlBase = forceEither $ get cp "DEFAULT" "oauthauthorize"+ let reqUrl = fromJust . parseURL $ reqUrlBase+ let accUrl = fromJust . parseURL $ accUrlBase+ let authUrl = ((authUrlBase ++ "?oauth_token=") ++ ) . + findWithDefault ("oauth_token", "") .+ oauthParams+ + let CurlM resp = + runOAuth $ + do ignite app+ liftIO $ d "ignite done. trying request 1."+ reqres1 <- tryRequest reqUrl+ case reqres1 of+ Left x -> -- hack around hoauth bug for identica+ do liftIO $ d "request 1 failed. attempting workaround."+ putToken $ AccessToken {application = app,+ oauthParams = empty}+ reqres2 <- tryRequest reqUrl+ case reqres2 of + Left x -> fail $ "Error from oauthRequest: " ++ show x+ Right _ -> return ()+ Right _ -> return ()+ twidgeAskAuthorization authUrl+ oauthRequest HMACSHA1 Nothing accUrl+ tok <- getToken+ return (twoLegged tok, threeLegged tok, tok)+ (leg2, leg3, response) <- resp+ -- on successful auth, leg3 is True. Otherwise, it is False.+ -- leg1 is always false and r appears to not matter.+ d $ show (leg2, leg3, oauthParams response)+ if leg3 + then do let newcp = forceEither $ set cp "DEFAULT" "oauthdata" .+ esc . show . fixIdentica . toList . oauthParams $ response+ writeCP cpath newcp+ putStrLn $ "Successfully authenticated!" + putStrLn "Twidge has now been configured for you and is ready to use."+ else putStrLn "Authentication failed; please try again" where confirmSetup =- do putStrLn "\nIt looks like you have already configured twidge."+ do putStrLn "\nIt looks like you have already authenticated twidge." putStrLn "If we continue, I may remove your existing"- putStrLn "configuration. Would you like to proceed?"+ putStrLn "authentication. Would you like to proceed?" putStr "\nYES or NO: " c <- getLine if (map toLower c) == "yes" then return ()- else permFail "Aborting configuration at user request."+ else permFail "Aborting setup at user request."+ tryRequest reqUrl = + do reqres <- oauthRequest HMACSHA1 Nothing reqUrl+ liftIO $ d $ "reqres params: " ++ case reqres of+ Left x -> " error " ++ x+ Right y -> show (oauthParams y)+ return reqres+ -- Work around a hoauth bug - identica doesn't return+ -- oauth_callback_confirmed+ fixIdentica :: [(String, String)] -> [(String, String)]+ fixIdentica inp =+ case lookup "oauth_callback_confirmed" inp of+ Nothing -> ("oauth_callback_confirmed", "true") : inp+ Just _ -> inp esc x = concatMap fix x fix '%' = "%%" fix x = [x] +twidgeAskAuthorization :: MonadIO m => (Token -> String) -> OAuthMonad m ()+twidgeAskAuthorization getUrl = + do token <- M.get+ answer <- liftIO $ do putStrLn "OK, next I need you to authorize Twidge to access your account."+ putStrLn "Please cut and paste this URL and open it in a web browser:\n"+ putStrLn (getUrl token)+ putStrLn "\nClick Allow when prompted. You will be given a numeric"+ putStrLn "key in your browser window. Copy and paste it here."+ putStrLn "(NOTE: some non-Twitter services supply no key; just leave this blank"+ putStrLn "if you don't get one.)\n"+ putStr "Authorization key: "+ getLine+ M.put (injectOAuthVerifier answer token)+ setup_help =- "Usage: twidge setup\n\n"+ "Usage: twidge setup\n\n"
Commands/Update.hs view
@@ -21,6 +21,7 @@ import System.Log.Logger import Types import System.Console.GetOpt+import System.Console.GetOpt.Utils import Data.List import Download import Control.Monad(when)@@ -28,13 +29,19 @@ import Data.ConfigFile import MailParser(message) import Text.ParserCombinators.Parsec+#ifdef USE_BITLY+import Network.Bitly (Account(..),bitlyAccount,jmpAccount,shorten)+#endif i = infoM "update" update = simpleCmd "update" "Update your status" update_help [Option "r" ["recvmail"] (NoArg ("m", "")) - "Receive update as body of email on stdin"]+ "Receive update as body of email on stdin",+ Option "i" ["inreplyto"] (ReqArg (stdRequired "i") "MSGID")+ "Indicate this message is in reply to MSGID"+ ] update_worker update_worker x cp ([("m", "")], []) =@@ -59,9 +66,21 @@ ([("source", "twidge"), ("status", poststatus)] ++ irt) debugM "update" $ "Got doc: " ++ xmlstr+ update_worker x cp ([], []) = do l <- getLine update_worker x cp ([], [l])++update_worker x cp ([("i", id )], []) =+ do l <- getLine+ update_worker x cp ([("i", id)], [l])++update_worker _ cp ([("i", id)], [status]) =+ do poststatus <- procStatus cp "update" status+ xmlstr <- sendAuthRequest cp "/statuses/update.xml" [] + [("source", "Twidge"), ("status", poststatus), ("in_reply_to_status_id", id)]+ debugM "update" $ "Got doc: " ++ xmlstr+ update_worker _ cp ([], [status]) = do poststatus <- procStatus cp "update" status xmlstr <- sendAuthRequest cp "/statuses/update.xml" [] @@ -72,7 +91,8 @@ procStatus cp section status = do poststatus <- case get cp section "shortenurls" of- Right True -> shortenUrls status+ Right True | length status > 140+ -> shortenUrls cp status _ -> return status when (length poststatus > 140) (permFail $ "Your status update was " ++ @@ -96,23 +116,53 @@ debugM "dmsend" $ "Got doc: " ++ xmlstr dmsend_worker _ _ _ = permFail "Syntax error; see twidge dmsend --help" -shortenUrls "" = return ""-shortenUrls status = +shortenUrls _ "" = return ""+shortenUrls cp status = do debugM "update" $ "shortenUrls considering: " ++ show status+ shortURL <- chooseShortener cp if match == "" then return before -- No match means no "after"- else do tiny <- mkTinyURL match+ else do tiny <- shortURL match debugM "update" $ "Got tinyurl: " ++ show tiny- rest <- shortenUrls after+ rest <- shortenUrls cp after return $ before ++ (if (length tiny < length match) then tiny else match) ++ rest where (before, match, after) = status =~ pat- pat = "(http|ftp)://[^ ]+"+ pat = "(http|https|ftp)\\://[a-zA-Z0-9\\-\\.]+(:[a-zA-Z0-9]*)?/?([-a-zA-Z0-9:\\._\\?\\,\\'/\\\\\\+&%\\$#\\=~])*" +#ifdef USE_BITLY+chooseShortener cp = do+ -- look either for [bitly] or [jmp] section in config+ let (sec, newAccount) = if has_section cp "bitly"+ then ("bitly", bitlyAccount)+ else ("jmp", jmpAccount)+ -- [bitly] or [jmp] section should define both login and apikey+ let acc = get cp sec "login" >>= \l ->+ get cp sec "apikey" >>= \k ->+ return $ newAccount { login=l, apikey=k }+ return $ case acc of+ Left _ -> mkTinyURL -- use default+ Right a -> mkBitlyURL a++mkBitlyURL acc url = do+ r <- shorten acc url+ case r of+ Left e -> permFail e -- report bit.ly errors+ Right shorturl -> return shorturl+#else+chooseShortener _ = return mkTinyURL+#endif+ mkTinyURL url = - simpleDownload $ "http://tinyurl.com/api-create.php?url=" ++ url+ simpleDownload . concat $ "http://is.gd/api.php?longurl=" : map escapeHashes url+ where+ -- NOTE: This technique works with the is.gd "API"+ -- but does not work with the tinyurl.com "API"+ escapeHashes :: Char -> String+ escapeHashes '#' = "%23"+ escapeHashes c = [c] update_help = "Usage: twidge update [status]\n\n\
Config.hs view
@@ -1,5 +1,5 @@ {- hpodder component-Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2006-2010 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -18,7 +18,7 @@ {- | Module : Config- Copyright : Copyright (C) 2006-2008 John Goerzen+ Copyright : Copyright (C) 2006-2010 John Goerzen License : GNU GPL, version 2 or above Maintainer : John Goerzen <jgoerzen@complete.org>@@ -36,10 +36,14 @@ import Data.Either.Utils import Data.String.Utils(strip, split) import System.Posix.Files(rename, setFileCreationMask)+import System.Log.Logger getDefaultCP = do return $ forceEither $ do cp <- set startingcp "DEFAULT" "urlbase" "https://twitter.com"+ cp <- set cp "DEFAULT" "oauthrequesttoken" "%(urlbase)s/oauth/request_token"+ cp <- set cp "DEFAULT" "oauthaccesstoken" "%(urlbase)s/oauth/access_token"+ cp <- set cp "DEFAULT" "oauthauthorize" "%(urlbase)s/oauth/authorize" cp <- set cp "DEFAULT" "sendmail" "/usr/sbin/sendmail" cp <- set cp "DEFAULT" "shortenurls" "yes" return cp@@ -50,16 +54,19 @@ do appdir <- getUserDocumentsDirectory return $ appdir ++ "/.twidgerc" -loadCP cpgiven = +loadCP useDefaultIfMissing cpgiven = do cpname <- case cpgiven of Nothing -> getCPName Just x -> return x defaultcp <- getDefaultCP dfe <- doesFileExist cpname+ debugM "Config" $ "CP " ++ cpname ++ " exists? " ++ show dfe if dfe then do cp <- readfile defaultcp cpname return $ forceEither cp- else do fail $ "No config file found at " ++ cpname ++ + else if useDefaultIfMissing+ then return defaultcp+ else do fail $ "No config file found at " ++ cpname ++ "\nRun twidge setup to configure twidge for use." writeCP cpgiven cp =
Download.hs view
@@ -1,5 +1,5 @@ {- hpodder component-Copyright (C) 2006-2007 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2006-2010 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -18,7 +18,7 @@ {- | Module : Download- Copyright : Copyright (C) 2006-2008 John Goerzen+ Copyright : Copyright (C) 2006-2010 John Goerzen License : GNU GPL, version 2 or above Maintainer : John Goerzen <jgoerzen@complete.org>@@ -32,45 +32,58 @@ module Download(sendAuthRequest, simpleDownload) where import System.Log.Logger import Data.ConfigFile-import HSH-import Data.Either.Utils(forceEither)-import Network.URI import Data.List-import Control.Exception(evaluate)+import Network.URI+import Data.Either.Utils(forceEither)+import Data.Maybe+import Network.OAuth.Http.Request+import Network.OAuth.Http.Response+import Network.OAuth.Consumer+import Network.OAuth.Http.HttpClient(request)+import TwidgeHttpClient+import OAuth+import Data.ByteString.Lazy.UTF8(toString) d = debugM "download" i = infoM "download" -curl = "curl"-curlopts = ["-A", "twidge v1.0.0; Haskell; GHC", -- Set User-Agent- "-s", -- Silent mode- "-S", -- Still show error messages- "-L", -- Follow redirects- "-y", "60", "-Y", "1", -- Timeouts- "--retry", "2", -- Retry twice- "-f" -- Fail on server errors- ]- simpleDownload :: String -> IO String-simpleDownload url = run (curl, curlopts ++ [url])+simpleDownload url =+ do r <- resp+ d $ "simpleDownload response from URL " ++ show url ++ ": " ++ show r+ return . toString . rspPayload $ r+ where CurlM resp = request (fromJust $ parseURL url) sendAuthRequest :: ConfigParser -> String -> [(String, String)] -> [(String, String)] -> IO String sendAuthRequest cp url getopts postoptlist =- do -- Force this to be evaluated in the parent process- authopts <- evaluate (getAuthOpts cp)- run (curl, curlopts ++ authopts ++ postopts ++ [urlbase ++ url ++ optstr])+ do app <- case getApp cp of + Nothing -> fail $ "Error: auth not set up for this host"+ Just x -> return x+ oauthdata <- case get cp "DEFAULT" "oauthdata" of + Left x -> fail $ "Need to (re-)run twidge setup to configure auth: "+ ++ show x+ Right y -> return y+ + let parsedUrl = fromJust . parseURL $ urlbase ++ url ++ optstr+ + -- add to the request the POST headers+ let request = parsedUrl {reqHeaders = + fromList (toList (reqHeaders parsedUrl) +++ postoptlist)+ }+ + let CurlM resp = runOAuth $ + do ignite app+ putToken $ AccessToken + {application = app,+ oauthParams = fromList (read oauthdata)+ }+ serviceRequest HMACSHA1 Nothing request+ r <- resp+ d $ "response: " ++ show r+ return . toString . rspPayload $ r where urlbase = forceEither $ get cp "DEFAULT" "urlbase" optstr = case getopts of [] -> "" _ -> "?" ++ (concat . intersperse "&" . map conv $ getopts) conv (k, v) = k ++ "=" ++ escapeURIString isUnreserved v- postopts = concatMap postopt postoptlist- postopt (k, v) = ["-d", escapeURIString isUnreserved k ++ "=" ++- escapeURIString isUnreserved v]--getAuthOpts :: ConfigParser -> [String]-getAuthOpts cp =- case (get cp "DEFAULT" "username", get cp "DEFAULT" "password") of- (Right user, Right pass) ->- ["--user", user ++ ":" ++ pass]- _ -> error "Missing username or password option in config file"
doc/twidge-manpage.sgml view
@@ -96,7 +96,7 @@ seen already and suppress those updates in future runs.</para></listitem> - <listitem><para>Optional automatic shortening of long URLs via tinyurl.com</para></listitem>+ <listitem><para>Optional automatic shortening of long URLs via is.gd</para></listitem> <listitem><para>Optional integration with your email system -- send and receive updates via email.</para></listitem>@@ -143,7 +143,7 @@ <para> To get started, simply run <command>twidge setup</command> at your shell prompt. &twidge; will lead you through the first-time- configuration -- which is only two questions and completely+ configuration -- which is very quick and completely self-explanatory! </para> <para>@@ -266,7 +266,9 @@ They all share a common syntax and common set of options. The commands are <command>lsarchive</command>, <command>lsdm</command>, <command>lsdmarchive</command>,- <command>lsrecent</command>, and <command>lsreplies</command>.+ <command>lsrecent</command>, <command>lsreplies</command>,+ <command>lsrt</command>, <command>lsrtarchive</command>,+ and <command>lsrtreplies</command>. Here are the common options: </para> @@ -392,12 +394,6 @@ of -s with this particular command. If -s has never before been used with this command, has no effect. </para>- <para>- As of September 2008, Identi.ca does not support the- since_id parameter that is required for this option to be- effective. A future version of &twidge; may implement a- workaround.- </para> </listitem> </varlistentry> </variablelist>@@ -411,8 +407,21 @@ <refsect2 id="twidge.commands.lsarchive"> <title>lsarchive</title> <para>- Lists your own posts.+ Lists your own posts. With the one+ <literal>lsarchive</literal> option, you can also list the+ posts of a specific other user: </para>+ <variablelist>+ <varlistentry>+ <term>-U <replaceable>USERNAME</replaceable></term>+ <term>--username=<replaceable>USERNAME</replaceable></term>+ <listitem><para>+ Instead of showing your own updates, instead show those of+ a differerent user.+ </para>+ </listitem>+ </varlistentry>+ </variablelist> </refsect2> <refsect2 id="twidge.commands.lsdm">@@ -447,6 +456,40 @@ to you. </para> </refsect2>++ <refsect2 id ="twidge.commands.lsrt">+ <title>lsrt</title>+ <para>+ Lists new-style retweets made by those that you follow. + </para>+ <para>+ Note: identi.ca doesn't support new-style retweets and will+ return an error on this command.+ </para>+ </refsect2>++ <refsect2 id="twidge.commands.lsrtarchive">+ <title>lsrtarchive</title>+ <para>+ Lists the new-style retweets you made yourself.+ </para>+ <para>+ Note: identi.ca doesn't support new-style retweets and will+ return an error on this command.+ </para>+ </refsect2>++ <refsect2 id="twidge.commands.lsrtreplies">+ <title>lsrtreplies</title>+ <para>+ List retweets of your statuses made by others.+ </para>+ <para>+ Note: identi.ca doesn't support new-style retweets and will+ return an error on this command.+ </para>+ </refsect2>+ </refsect1> <refsect1 id="twidge.commands.displayinfo">@@ -516,7 +559,7 @@ </para> <para> By default, Twidge will attempt to shorten URLs in your- updates via the TinyURL.com service. You can disable this by+ updates via the is.gd service. You can disable this by setting shortenurls = no in the [DEFAULT] or [dmsend] section of your configuration file. </para>@@ -562,6 +605,8 @@ <title>update</title> <cmdsynopsis> <command>twidge update</command>+ <arg choice="opt">-i <replaceable>MSGID</replaceable> |+ --inreplyto <replaceable>MSGID</replaceable></arg> <arg choice="opt"><replaceable>status</replaceable></arg> </cmdsynopsis> <cmdsynopsis>@@ -607,6 +652,11 @@ your signature as well. &twidge; will convert newline characters to spaces when processing your message body. </para>+ <para>+ When -i is given, the internal Twitter ID of a message is+ expected to be passed. This sets the "in reply to" flag on+ Twitter appropriately.+ </para> </refsect2> </refsect1> @@ -640,8 +690,8 @@ The section named DEFAULT is special in that it provides defaults that will be used whenever an option can't be found under a different section. If you specify no section names,- DEFAULT is the assumed section. Some items, such as username,- password, and urlbase are assumed to be in DEFAULT.+ DEFAULT is the assumed section. Some items, such as urlbase,+ are assumed to be in DEFAULT. </para> <para> Let's start by looking at an example file, and then proceed to@@ -650,11 +700,6 @@ <programlisting><![CDATA[ [DEFAULT] -; Username and password-username = ilovetwidge--password = secret- ; If your password contains a percent sign (%), list it twice (%%) ; Path to server API interface -- no trailing slash@@ -675,8 +720,7 @@ option, it first checks to see if it can find that option in a section for that option. If not, it checks the <option>DEFAULT</option> section. If it still doesn't find an- answer, it consults its built-in defaults. The only built-in- default at present is urlbase.+ answer, it consults its built-in defaults. </para> <refsect2 id="twidge.config.general"> <title>General Options</title>@@ -684,16 +728,6 @@ section. </para> <variablelist>- <varlistentry><term>username</term>- <listitem><para>- Your username on the microblogging site. No default.- </para></listitem>- </varlistentry>- <varlistentry><term>password</term>- <listitem><para>- Your password on the microblogging site. No default.- </para></listitem>- </varlistentry> <varlistentry><term>urlbase</term> <listitem><para> The URL to access the API of the microblogging site.@@ -703,6 +737,50 @@ trailing slash on this option. </para></listitem> </varlistentry>+ <varlistentry><term>oauthrequesttoken</term>+ <listitem><para>+ The URL to access the oAuth request token interface. The+ default,+ <literal>%(urlbase)s/oauth/request_token</literal>, will+ work with most environments.+ </para>+ </listitem>+ </varlistentry>+ <varlistentry><term>oauthaccesstoken</term>+ <listitem><para>+ The oAuth access token URL. Default is+ <literal>%(urlbase)s/oauth/access_token</literal>.+ </para></listitem>+ </varlistentry>+ <varlistentry><term>oauthauthorize</term>+ <listitem><para>+ The oAuth authorize URL. Default is+ <literal>%(urlbase)s/oauth/authorize</literal>.+ </para>+ </listitem>+ </varlistentry>+ <varlistentry><term>oauthconsumerkey</term>+ <listitem><para>+ The oAuth consumer key. Twidge is registered with+ Twitter and identi.ca and will supply a reasonable+ default for those two based on the content of urlbase.+ </para>+ </listitem>+ </varlistentry>+ <varlistentry><term>oauthconsumersecret</term>+ <listitem><para>+ The oAuth consumer secret. A default is provided as+ with oauthconsumerkey.+ </para>+ </listitem>+ </varlistentry>+ <varlistentry><term>oauthdata</term>+ <listitem><para>+ Automatically written by <command>twidge+ setup</command>. Do not alter.+ </para>+ </listitem>+ </varlistentry> </variablelist> </refsect2> @@ -742,6 +820,16 @@ </listitem> </varlistentry> + <varlistentry><term>savelast</term>+ <listitem><para>+ For one of the "ls" class of commands, implies -s on+ every invocation, rather than require it to be manually+ given. This option need only be present; the value you+ give it doesn't mater.+ </para>+ </listitem>+ </varlistentry>+ <varlistentry><term>sendmail</term> <listitem><para> Stores the path to the sendmail executable on your@@ -766,6 +854,36 @@ </refsect2> + <refsect2 id="twidge.config.shortening">+ <title>URL Shortening Options</title>+ <para>+ To enable the bit.ly or j.ump URL shorteners, you must add a+ <literal>[bitly]</literal> or <literal>[jmp]</literal> section+ to the configuration file. This should contain two entries:+ <literal>login</literal> and <literal>apikey</literal> as+ found in <ulink url="http://bit.ly/account/"></ulink>. For+ example:+ </para>+ <programlisting>+[jmp]+login: bitlyapidemo+apikey: R_0da49e0a9118ff35f52f629d2d71bf07+ </programlisting>+ </refsect2>++ <refsect2 id="twidge.config.aliases">+ <title>Aliases</title>+ <para>+ You can add an <literal>[alias]</literal> section to the+ config file which will effectively create new commands. For+ example:+ </para>+ <programlisting>+[alias]+recent: lsrecent -u+replies: lsreplies -u+ </programlisting>+ </refsect2> </refsect1>
+ twidge.bash_completion view
@@ -0,0 +1,31 @@+#-*- mode: shell-script;-*-++# twidge command line completion.+# Copyright 2010 Ernesto Hernández-Novich <emhn@itverx.com.ve>+# Licensed under the GNU General Public License, version 2++have twidge &&+_twidge()+{+ local cur+ cur=${COMP_WORDS[COMP_CWORD]}++ COMPREPLY=()++ if (($COMP_CWORD == 1)); then+ COMPREPLY=( $( twidge lscommands | tail --lines=+4 | cut -f1 -d' '| grep "^$cur" ) )+ return 0+ fi++ local i=${#COMPREPLY[*]}+ local colonprefixes=${cur%"${cur##*:}"}+ while [ $((--i)) -ge 0 ]; do+ COMPREPLY[$i]=`printf %q "${COMPREPLY[$i]}"`++ COMPREPLY[$i]=${COMPREPLY[$i]#"$colonprefixes"} + done+ return 0++}+[ "$have" ] && complete -F _twidge -o default twidge+
twidge.cabal view
@@ -1,5 +1,5 @@ Name: twidge-Version: 0.99.3+Version: 1.0.0 License: GPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -11,7 +11,8 @@ doc/man.twidge.sgml, doc/printlocal.dsl, doc/sgml-common/COPYING, doc/sgml-common/COPYRIGHT, doc/sgml-common/ChangeLog, doc/sgml-common/Makefile.common, doc/sgml-common/SConstruct,- doc/sgml-common/ps2epsi+ doc/sgml-common/ps2epsi,+ twidge.bash_completion homepage: http://software.complete.org/twidge Build-type: Simple Category: Network@@ -38,15 +39,27 @@ how to use it, can be found at the twidge website at http://software.complete.org/twidge. -Build-Depends: network, unix, parsec, MissingH>=1.0.0,- mtl, base, HaXml>=1.13.2, HaXml<1.19, hslogger,- ConfigFile, directory, HSH, regex-posix, utf8-string+Cabal-Version: >=1.2.3 -Executable: twidge-Main-Is: twidge.hs-Other-Modules: Commands, Commands.Follow, Commands.Ls,+Flag withBitly+ description: Enable bit.ly and j.mp shorteners (requires Bitly module)+ default: False+++Executable twidge+ Build-Depends: network, unix, parsec, MissingH>=1.0.0,+ mtl, base >= 4 && < 5, HaXml>=1.13.2, HaXml<1.19, hslogger, hoauth,+ ConfigFile, directory, HSH, regex-posix, utf8-string, binary,+ bytestring, curl++ if flag(withBitly)+ Build-Depends: Bitly+ CPP-OPTIONS: USE_BITLY++ Main-Is: twidge.hs+ Other-Modules: Commands, Commands.FollowBlock, Commands.Ls, Commands.Setup, Commands.Update, Config, Download, FeedParser, MailParser, Types, Utils-GHC-Options: -O2-Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances+ GHC-Options: -O2+ Extensions: ExistentialQuantification, OverlappingInstances,+ UndecidableInstances, CPP
twidge.hs view
@@ -40,7 +40,7 @@ import Commands import Types import Control.Monad-import Data.ConfigFile(emptyCP)+import Data.ConfigFile(emptyCP,get) import System.IO import Paths_twidge(version) import Data.Version@@ -58,6 +58,8 @@ "Use specified config file", Option "" ["help"] (NoArg ("help", "")) "Display this help"] +expandAlias cp cmd = either (const cmd) id $ get cp "alias" cmd+ worker args commandargs = do when (lookup "help" args == Just "") $ usageerror "" when (lookup "d" args == Just "") @@ -65,13 +67,17 @@ handler <- streamHandler stderr DEBUG -- stdout has issues with HSH updateGlobalLogger "" (setHandlers [handler]) let commandname = head cmdargs- case lookup commandname allCommands of- Just command -> - do cp <- if commandname `elem` ["lscommands", "setup"] -- no config file needed- then return emptyCP- else loadCP (lookup "c" args)- execcmd command (tail cmdargs) (lookup "c" args) cp- Nothing -> usageerror ("Invalid command name " ++ commandname)+ cp <- if commandname `elem` ["lscommands", "setup"] -- no config file needed+ then loadCP True (lookup "c" args)+ else loadCP False (lookup "c" args)+ let cmdargs' = (words $ expandAlias cp commandname) ++ (tail cmdargs)+ let commandname' = head cmdargs'+ case lookup commandname' allCommands of+ Just command -> execcmd command (tail cmdargs') (lookup "c" args) cp+ Nothing -> if commandname == commandname'+ then usageerror ("Invalid command name " ++ commandname)+ else usageerror ("Invalid command name " ++ commandname+ ++ " (aliased to " ++ commandname' ++ ")") where cmdargs = case commandargs of [] -> ["help"] x -> x