packages feed

feed2twitter (empty) → 0.2.0

raw patch · 6 files changed

+385/−0 lines, 6 filesdep +basedep +bytestringdep +download-curlsetup-changed

Dependencies added: base, bytestring, download-curl, feed, hs-twitter

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2009,  Tom Lokhorst++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ feed2twitter.cabal view
@@ -0,0 +1,47 @@+name:                feed2twitter+version:             0.2.0+synopsis:            Send posts from a feed to Twitter+description:         Reads feeds and tweets each post to a Twitter account.+                     This is both a library and a simple executable build on top+                     of it.+                     .+                     The feed is read only once. To keep updating, call this +                     program/library every few minutes.+                     A local cache of earlier tweets is kept in a file to make+                     sure no duplicates are sent.+                     .+                     To build your own program on top of this library use the+                     `atom2twitter` or `rss2twitter` functions. If you need+                     access to the complete feed instead of just individual+                     individual items, use the `feed2twitter` function.+                     .+                     See the `hackage2twitter` program for an example of how to+                     use this library.+                     .+                     The executable can be used as such:+                     .+                     > $ feed2twitter http://example.com/feed.rss username password cache-file 50 [--debug-mode]+license:             BSD3+license-file:        LICENSE+author:              Tom Lokhorst+maintainer:          Tom Lokhorst <tom@lokhorst.eu>+homepage:            http://github.com/tomlokhorst/feed2twitter+stability:           Experimental+category:            Web+build-type:          Simple+cabal-version:       >= 1.6++library+  build-depends:     base >= 4,+                     bytestring >= 0.9.1.4,+                     download-curl >= 0.1.1,+                     feed >= 0.3.6,+                     hs-twitter >= 0.2.5+  hs-source-dirs:    src+  exposed-modules:   Web.Feed2Twitter+  other-modules:     Web.Feed2Twitter.Twitter++executable feed2twitter+  main-is:           Main.hs+  hs-source-dirs:    src+
+ src/Main.hs view
@@ -0,0 +1,99 @@+-------------------------------------------------------------------------------+-- |+-- Module      : Main+-- Copyright   : (c) 2009, Tom Lokhorst+-- License     : BSD3+--+-- Maintainer  : Tom Lokhorst <tom@lokhorst.eu>+-- Stability   : Experimental+--+-- Main module for `feed2twitter` executable.+-- Contains generic Atom entry and RSS item to Tweet map functions.+--+-------------------------------------------------------------------------------+module Main where++import Web.Feed2Twitter++import Text.Atom.Feed+import Text.RSS.Syntax++import Data.List+import System.Console.GetOpt+import System.Environment+import System.IO++main :: IO ()+main = do+  args <- getArgs+  (cfg, rest) <- processArgs defaultConfig options header args+  if length rest /= 5+   then putStrLn $ usageInfo header options+   else do+        let cfg' = cfg { feedUrl   = rest !! 0+                       , username  = rest !! 1+                       , password  = rest !! 2+                       , cacheFile = rest !! 3+                       , cacheSize = read $ rest !! 4+                       }+        item2twitter cfg' item2tweet+  where+    header = "Usage: feed2twitter FEED-URL USERNAME PASSWORD CACHE-FILE"+              ++ " CACHE-SIZE [OPTIONS...], with the following options:"+++item2tweet :: Either Entry RSSItem -> Tweet+item2tweet (Left entry) =+  if null (entryLinks entry)+  then trunc4tweet s+  else trunc4url s ++ linkHref (head (entryLinks entry))+  where+    title = showTextContent $ entryTitle entry+    s = case (entryAuthors entry, entrySummary entry) of+          ([], Nothing) -> title+          (as, Nothing) -> title ++ " by " ++ intercalate ", " (map personName as)+          ([], Just s ) -> title ++ ": " ++ showTextContent s+          (as, Just s ) -> title ++ " by " ++ intercalate ", " (map personName as)+                             ++ ": " ++ showTextContent s+item2tweet (Right item) = maybe (trunc4tweet s) (trunc4url s ++) (rssItemLink item)+  where+    -- Stupid optional fields...+    s = case (rssItemTitle item, rssItemAuthor item, rssItemDescription item) of+          (Nothing   , Nothing  , Nothing  ) -> ""+          (Just title, Nothing  , Nothing  ) -> title+          (Nothing   , Just auth, Nothing  ) -> auth ++ " posted."+          (Just title, Just auth, Nothing  ) -> title ++ " by " ++ auth+          (Nothing   , Nothing  , Just desc) -> desc+          (Just title, Nothing  , Just desc) -> (title ++ " " ++ desc)+          (Nothing   , Just auth, Just desc) -> auth ++ ": " ++ desc+          (Just title, Just auth, Just desc) -> title ++ " by " ++ auth ++ ": " ++ desc++showTextContent :: TextContent -> String+showTextContent (TextString s)  = s+showTextContent (HTMLString s)  = s -- Todo: make better+showTextContent (XHTMLString e) = show e -- Todo: also make better++defaultConfig :: Config+defaultConfig = Config+  { feedUrl = ""+  , username = ""+  , password = ""+  , cacheFile = ""+  , cacheSize = 0+  , debugMode = False+  }++options :: [OptDescr (Config -> Config)]+options =+  [ Option ['d'] ["debug-mode"] (NoArg (\c -> c { debugMode = True })) "Debug mode, send tweets to stdout."+  -- , Option ['V'] ["version"] (NoArg (\c -> c { showVersion = True })) "Show program version."+  ]++-- Seems like this function should already exist somewhere in a package.+processArgs :: a -> [OptDescr (a -> a)] -> String -> [String] -> IO (a, [String])+processArgs defaultConfig options header args =+  case getOpt Permute options args of+    (oargs, nonopts, []    ) -> return (foldl (flip ($)) defaultConfig oargs, nonopts)+    (_    , _      , errors) -> ioError $ userError $ (concat errors) ++ usageInfo header options++
+ src/Web/Feed2Twitter.hs view
@@ -0,0 +1,181 @@+-------------------------------------------------------------------------------+-- |+-- Module      : Web.Feed2Twitter+-- Copyright   : (c) 2009, Tom Lokhorst+-- License     : BSD3+--+-- Maintainer  : Tom Lokhorst <tom@lokhorst.eu>+-- Stability   : Experimental+--+-- This module exposes several functions and data types to send feeds to+-- Twitter.+--+-------------------------------------------------------------------------------+module Web.Feed2Twitter+  (+  -- * Types+    Config (..)+  , Tweet+  , GUID++  -- * Convenient user functions+  , atom2twitter+  , rss2twitter+  , item2twitter++  -- * Main function+  , feed2twitter++  -- * Util functions+  , trunc4tweet+  , trunc4url+  ) where++import Web.Feed2Twitter.Twitter++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Network.Curl.Download+import Text.Atom.Feed+import Text.Feed.Import+import Text.RSS.Syntax+import Text.Feed.Types (Feed (AtomFeed, RSSFeed))+import qualified Text.Feed.Types as Feed++import Control.Exception+import Control.Monad+import Data.Maybe+import Data.List+import Data.Ord (comparing)+import System.IO++-- | Configuration data for the `feed2twitter` function.+data Config = Config+  { feedUrl   :: String+  , username  :: String+  , password  :: String+  , cacheFile :: FilePath+  , cacheSize :: Int+  , debugMode :: Bool+  }+  deriving Show++-- | Represents a single tweet.+-- In principle this should be <= 140 characters, however, because Twitter uses+-- a url-shortener, a tweet containing a url may exeed this limit.+type Tweet = String++-- | A unique identifier for a Tweet.+-- Values of this type are stored in the cache file to make sure no duplicate+-- messages are sent to Twitter.+type GUID  = String++-- | Sends an Atom feed to Twitter by using user-provided mapping function+-- for individual entries.+--+-- This is a specialized version of `item2twitter`.+atom2twitter :: Config -> (Entry -> Tweet) -> IO ()+atom2twitter cfg f = item2twitter cfg g+  where+    err = "Web.Feed2Twitter.atom2twitter: "+    g (Left e)  = f e+    g (Right _) = error $ err ++ "Item not an Atom entry"++-- | Sends a RSS feed to Twitter by using user-provided mapping function+-- for individual items.+--+-- This is a specialized version of `item2twitter`.+rss2twitter :: Config -> (RSSItem -> Tweet) -> IO ()+rss2twitter cfg f = item2twitter cfg g+  where+    err = "Web.Feed2Twitter.rss2twitter: "+    g (Left _)  = error $ err ++ "Item not a RSS item"+    g (Right i) = f i++-- | Sends feed items to Twitter by using user-provided mapping function+-- for individual items.+-- +-- Defined in terms of `feed2twitter`.+item2twitter :: Config -> (Either Entry RSSItem -> Tweet) -> IO ()+item2twitter cfg f = feed2twitter cfg g+  where+    err = "Web.Feed2Twitter.items2twitter: "++    -- Feeds are asumed to be in reverse chronological order.+    -- Tweets are posted in chronological order.+    g (AtomFeed af) = map atom . reverse . feedEntries $ af+    g (RSSFeed rf)  = map rss  . reverse . rssItems . rssChannel $ rf+    g _             = error $ err ++ "Feed not an Atom or RSS feed"++    atom entry      = (entryId entry, f (Left entry))+    rss ri          = (guid, f (Right ri))+     where+       guid = maybe (filter (/='\n') $ show ri) rssGuidValue (rssItemGuid ri)++-- | Function that does all the heavy lifting:+--+-- - Downloads the feed provided in the config value.+--+-- - Calls the provided user-function to map feed to a list of guids and tweets.+--+-- - Filters out already posted tweets using guid cache.+--+-- - Sends each tweet to Twitter and writes its guid to cache file.+--+-- - Truncate cache file to size provided in config value.+-- +-- User-function is responsible for generating guids for tweets and the order+-- of tweets.+feed2twitter :: Config -> (Feed.Feed -> [(GUID, Tweet)]) -> IO ()+feed2twitter cfg f = do+    feed' <- openAsFeed (feedUrl cfg)+    case feed' of+      Left s     -> error $ err ++ s+      Right feed -> do+        let tweets' = f feed+        touchFile (cacheFile cfg)+        cfc <- BS.readFile (cacheFile cfg)+        let guids = lines (BSC.unpack cfc)+        let tweets = filter (pred guids) tweets'+        mapM_ tweetAndCache tweets+        when (not $ null tweets) cleanupCache+  where+    err = "Web.Feed2Twitter.feed2twitter: "++    -- Quick hack to create the file if it didn't exist+    touchFile f = openFile f ReadWriteMode >>= hClose++    pred guids (g, t) = not (g `elem` guids || t == "")+    cleanupCache = do+      guids' <- BS.readFile (cacheFile cfg)+      let guids = BSC.unlines . reverse . take (cacheSize cfg) . reverse+                   . BSC.lines $ guids'+      BS.writeFile (cacheFile cfg) guids++    tweetAndCache (guid, t) =+      if debugMode cfg+       then putStrLn ("tweet: " ++ t)+       else do+            tweet (username cfg) (password cfg) t++            -- Immediately write to cache after tweet, in case process crashes+            BS.appendFile (cacheFile cfg) (BSC.pack $ guid ++ "\n")++-- | Truncates a string to 140 characters for a tweet.+--+-- When input is longer than 140 characters, puts an ellipsis at the end.+trunc4tweet :: String -> String+trunc4tweet s = if length s <= 140+                then s+                else take 139 s ++ "\8230"++-- | Truncates a string to 120 characters, leaving room for a space and a url.+-- Due to Twitter using a url-shortener, urls are assumed to max 20 characters.+--+-- When input is shorter than 120 characters, returns it with a space,+-- otherwise truncates and puts an ellipsis and space at the end.+trunc4url :: String -> String+trunc4url s = if length s <= 119+              then s ++ " "+              else take 118 s ++ "\8230 "+
+ src/Web/Feed2Twitter/Twitter.hs view
@@ -0,0 +1,27 @@+-------------------------------------------------------------------------------+-- |+-- Module      : Web.Feed2Twitter.Twitter+-- Copyright   : (c) 2009, Tom Lokhorst+-- License     : BSD3+--+-- Maintainer  : Tom Lokhorst <tom@lokhorst.eu>+-- Stability   : Experimental+--+-- Twitter functions, build on hs-twitter package.+--+-------------------------------------------------------------------------------+module Web.Feed2Twitter.Twitter where++import Web.Twitter.Fetch+import Web.Twitter.Monad++import System.Environment++tweet :: String -> String -> String -> IO ()+tweet username password message = do+  runTM (AuthUser username password)+    $ postMethod+    $ restCall "update.json" (arg "status" message [])+  return ()++