twidge-1.0.0: Commands/Update.hs
{-
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 System.Console.GetOpt.Utils
import Data.List
import Download
import Control.Monad(when)
import Text.Regex.Posix
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",
Option "i" ["inreplyto"] (ReqArg (stdRequired "i") "MSGID")
"Indicate this message is in reply to MSGID"
]
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 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" []
[("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 | length status > 140
-> shortenUrls cp 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 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 <- shortURL match
debugM "update" $ "Got tinyurl: " ++ show tiny
rest <- shortenUrls cp after
return $
before ++ (if (length tiny < length match)
then tiny else match)
++ rest
where (before, match, after) = status =~ pat
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 . 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\
\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"