twidge 0.99.0 → 0.99.0.1
raw patch · 5 files changed
+338/−4 lines, 5 files
Files
- Commands/Follow.hs +60/−0
- Commands/Setup.hs +75/−0
- Commands/Update.hs +133/−0
- MailParser.hs +66/−0
- twidge.cabal +4/−4
+ Commands/Follow.hs view
@@ -0,0 +1,60 @@+{-+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/Setup.hs view
@@ -0,0 +1,75 @@+{-+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.Setup(setup) where+import Utils+import System.Log.Logger+import Data.List+import Data.ConfigFile+import System.IO+import Data.Either.Utils+import Data.Char+import Config+import Control.Monad(when)++i = infoM "setup"++--------------------------------------------------+-- lscasts+--------------------------------------------------++setup = simpleCmd "setup" "Interactively configure twidge for first-time use"+ 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'+ + putStrLn "\n\ntwidge has now been configured for you.\n"+ where confirmSetup =+ do putStrLn "\nIt looks like you have already configured twidge."+ putStrLn "If we continue, I may remove your existing"+ putStrLn "configuration. 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."+ esc x = concatMap fix x+ fix '%' = "%%"+ fix x = [x]++setup_help =+ "Usage: twidge setup\n\n"
+ Commands/Update.hs view
@@ -0,0 +1,133 @@+{-+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.Update(update, dmsend) where+import Utils+import System.Log.Logger+import Types+import System.Console.GetOpt+import Data.List+import Download+import Control.Monad(when)+import Text.Regex.Posix+import Data.ConfigFile+import MailParser(message)+import Text.ParserCombinators.Parsec++i = infoM "update"++update = simpleCmd "update" "Update your status"+ update_help+ [Option "r" ["recvmail"] (NoArg ("m", "")) + "Receive update as body of email on stdin"]+ update_worker++update_worker x cp ([("m", "")], []) =+ do c <- getContents+ case parse message "(stdin)" c of+ Left x -> permFail $ "Couldn't parse mail: " ++ show x+ Right (refs, body) ->+ let irt = case refs =~ "<([^>]+)>$" of+ "" -> []+ m -> case parseMsgId m of+ Nothing -> []+ Just (m, host, section) ->+ if host == serverHost cp && + section `elem` ["lsrecent", "lsarchive",+ "lsreplies"]+ then [("in_reply_to_status_id",+ sId m)]+ else []+ status = body+ in do poststatus <- procStatus cp "update" status+ xmlstr <- sendAuthRequest cp "/statuses/update.xml" []+ ([("source", "Twidge"), ("status", poststatus)] +++ irt)+ debugM "update" $ "Got doc: " ++ xmlstr+update_worker x cp ([], []) =+ do l <- getLine+ update_worker x cp ([], [l])+update_worker _ cp ([], [status]) =+ do poststatus <- procStatus cp "update" status+ xmlstr <- sendAuthRequest cp "/statuses/update.xml" [] + [("source", "Twidge"), ("status", poststatus)]+ debugM "update" $ "Got doc: " ++ xmlstr+update_worker _ _ _ =+ permFail "update: syntax error; see twidge update --help"++procStatus cp section status =+ do poststatus <- case get cp section "shortenurls" of+ Right True -> shortenUrls status+ _ -> return status+ when (length poststatus > 140)+ (permFail $ "Your status update was " ++ + show (length poststatus) +++ " characters; max length 140")+ return poststatus++dmsend = simpleCmd "dmsend" "Send direct message"+ dmsend_help+ []+ dmsend_worker++dmsend_worker x cp ([], [r]) =+ do l <- getLine+ dmsend_worker x cp ([], [r, l])+dmsend_worker x cp ([], [recipient, status]) =+ do poststatus <- procStatus cp "dmsend" status+ xmlstr <- sendAuthRequest cp "/direct_messages/new.xml" []+ [("source", "Twidge"), + ("text", poststatus), ("user", recipient)]+ debugM "dmsend" $ "Got doc: " ++ xmlstr+dmsend_worker _ _ _ = permFail "Syntax error; see twidge dmsend --help"++shortenUrls "" = return ""+shortenUrls status = + do debugM "update" $ "shortenUrls considering: " ++ show status+ if match == ""+ then return before -- No match means no "after"+ else do tiny <- mkTinyURL match+ debugM "update" $ "Got tinyurl: " ++ show tiny+ rest <- shortenUrls after+ return $ + before ++ (if (length tiny < length match)+ then tiny else match)+ ++ rest+ where (before, match, after) = status =~ pat+ pat = "(http|ftp)://[^ ]+"++mkTinyURL url = + simpleDownload $ "http://tinyurl.com/api-create.php?url=" ++ url++update_help =+ "Usage: twidge update [status]\n\n\+ \Updates your status to the given status. You will most likely need to\n\+ \quote this to prevent interference from the shell. For instance:\n\n\+ \ twidge update \"At home, baking.\"\n\n\+ \You can also omit the status, in which case a single line will be read\n\+ \from stdin and taken as your update. Example:\n\n\+ \ date | twidge update\n"++dmsend_help =+ "Usage: twidge dmsend recipient [status]\n\n\+ \Sends a direct message to the given recipient. You will most likely need\n\+ \to quote this to prevent interference from the shell. For instance:\n\n\+ \ twidge dmsend unixtwidge \"At home, baking.\"\n\n\+ \You can also omit the status, in which case a single line will be read\n\+ \from stdin and taken as your update. Example:\n\n\+ \ date | twidge dmsend unixtwidge\n"
+ MailParser.hs view
@@ -0,0 +1,66 @@+{-+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 MailParser where+import Text.ParserCombinators.Parsec+import Data.String.Utils+import FeedParser(sanitize)++eol = (string "\r\n") <|> string "\n"++line = do l <- many (noneOf "\r\n")+ eol+ return l++line1 = do l <- many1 (noneOf "\r\n")+ eol+ return l++header =+ do c1 <- (refHdr <|> (line1 >> return ""))+ return c1++refHdr = + do try (string "References: ")+ c <- line+ c2 <- restOfHdr+ return (c ++ c2)+ where restOfHdr =+ (do oneOf " \t"+ r <- line+ n <- restOfHdr+ return (r ++ n)) <|> return ""+ +headers = many1 header++maybeFrom = try (do string "From "+ many1 (noneOf "\r\n")+ eol+ return ()+ ) <|> (return ())++body = do b <- many anyChar+ eof+ return b++message =+ do maybeFrom+ h <- headers+ eol+ b <- body+ return (strip (concat h), strip . sanitize $ b)
twidge.cabal view
@@ -1,5 +1,5 @@ Name: twidge-Version: 0.99.0+Version: 0.99.0.1 License: GPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -44,9 +44,9 @@ Executable: twidge Main-Is: twidge.hs-Other-Modules: Commands, Config, Download, FeedParser,- Types, Utils, - Commands.Ls+Other-Modules: Commands, Commands.Follow, Commands.Ls,+ Commands.Setup, Commands.Update, Config, Download, FeedParser,+ MailParser, Types, Utils GHC-Options: -O2 Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances