imm (empty) → 0.1.0.0

raw patch · 9 files changed

+406/−0 lines, 9 filesdep +HTTPdep +basedep +bytestringsetup-changed

Dependencies added: HTTP, base, bytestring, cmdargs, directory, dyre, feed, filepath, imm, mime-mail, network, old-locale, random, text, time, utf8-string, xml

Files

• Imm/Core.hs +179/−0
• Imm/Mail.hs +33/−0
• Imm/Maildir.hs +41/−0
• Imm/Main.hs +7/−0
• Imm/Types.hs +52/−0
• Imm/Util.hs +24/−0
• LICENSE +13/−0
• Setup.hs +2/−0
• imm.cabal +55/−0

@@ -0,0 +1,179 @@+module Imm.Core where++-- {{{ Imports+import Imm.Mail+import qualified Imm.Maildir as Maildir+import Imm.Types+import Imm.Util++import qualified Config.Dyre as D+import Config.Dyre.Paths++--import Control.Arrow+import Control.Monad hiding(forM_)++import Data.Foldable+--import Data.Functor+--import Data.Maybe+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Time.Format++import Network.HTTP hiding(Response)+import Network.URI++import System.Console.CmdArgs+import System.Directory+import System.FilePath+import System.IO+import System.IO.Error+import System.Locale++import qualified Text.Feed.Import as F+import Text.Feed.Query+import Text.Feed.Types+-- }}}++-- {{{ Commandline options                                                                             +-- | Available commandline options+cliOptions :: CliOptions+cliOptions = CliOptions {+    mParameter = def &= help "option description" &= explicit &= name "p" &= name "parameter" &= typ "type of the argument"+}++getOptions :: IO CliOptions+getOptions = cmdArgs $ cliOptions+    &= verbosityArgs [explicit, name "Verbose", name "v"] []+    &= versionArg [ignore]+    &= help "Fetch and send items from RSS/Atom feeds to a custom mail address."+    &= helpArg [explicit, name "help", name "h"]+    &= program "imm"+-- }}}++-- {{{ Configuration+dyreParameters :: D.Params Parameters+dyreParameters = D.defaultParams {+  D.projectName  = "imm",+  D.showError    = showError,+  D.realMain     = realMain,+  D.ghcOpts      = ["-threaded"],+  D.statusOut    = hPutStrLn stderr+}++showError :: Parameters -> String -> Parameters+showError parameters message = parameters { mError = Just message }++-- | Default configuration.+defaultParameters :: Parameters+defaultParameters = Parameters {+    mCacheDirectory = Nothing,+    mFeedURIs       = [],+    mMailDirectory  = "rss",+    mError          = Nothing+}+-- }}}++-- | +imm :: Parameters -> IO ()+imm = D.wrapMain dyreParameters++-- Entry point+realMain :: Parameters -> IO ()+realMain parameters@Parameters{ mMailDirectory = directory } = do+-- Print configuration error, if any+    forM_ (mError parameters) putStrLn+    +-- Parse commandline arguments+    options <- getOptions++-- Print in-use paths+    (a, b, c, d, e) <- getPaths dyreParameters +    whenLoud . putStrLn . unlines $ [+        "Current binary:  " ++ a,+        "Custom binary:   " ++ b,+        "Config file:     " ++ c,+        "Cache directory: " ++ d,+        "Lib directory:   " ++ e]+        +-- Initialize mailbox+    result <- Maildir.init directory+    case result of+        False -> putStrLn $ "Unable to initialize maildir at: " ++ directory+        _     -> realMain' parameters+   +-- At this point, a maildir has been setup.+realMain' :: Parameters -> IO ()+realMain' parameters@Parameters{ mFeedURIs = feedURIs } = do    +    let uris   = map parseURI' feedURIs +    rawFeeds  <- mapM (either (return . Left) downloadRaw) uris +    let feeds  = zip feedURIs . map (parseFeedString =<<) $ rawFeeds+    +    void . mapM (processFeed parameters) $ feeds +    return ()++parseURI' :: String -> Either String URI+parseURI' uri = maybe (Left . ("Ill-formatted URI: " ++) $ uri) (Right) . parseURI $ uri++processFeed :: Parameters -> (String, Either String Feed) -> IO ()+processFeed _ (_, Left e) = putStrLn e+processFeed parameters (uri, Right feed) = do+    whenLoud . putStr . unlines $ [+        "Processing feed: " ++ uri,+        ("Title:  " ++) . getFeedTitle $ feed,+        ("Author: " ++) . maybe "No author" id . getFeedAuthor $ feed,+        ("Home:   " ++) . maybe "No home"   id . getFeedHome $ feed]+    +    (_, _, _, d, _) <- getPaths dyreParameters+    let directory = maybe d id . mCacheDirectory $ parameters  +    let fileName  = uri >>= escapeFileName+    +-- +    oldTime <- try $ readFile (directory </> fileName)+    let threshold = either+          (const $ posixSecondsToUTCTime 0)+          (maybe (posixSecondsToUTCTime 0) id . parseTime defaultTimeLocale "%F %T %Z")+          oldTime+    +    lastTime <- foldlM (\acc item -> processItem parameters threshold item >>= (return . (max acc))) threshold (feedItems feed) +    +-- +    (file, handle) <- openTempFile directory fileName+    hPutStrLn handle (show lastTime)+    hClose handle+    renameFile file (directory </> fileName)+    +    return ()++processItem :: Parameters -> UTCTime -> Item -> IO UTCTime+processItem parameters@Parameters{ mMailDirectory = directory } threshold item = do+    currentTime <- getCurrentTime :: IO UTCTime+    let time = getItemDate item+  +    whenLoud . putStr . unlines $ ["",+        "   Item author: " ++ (maybe "" id $ getItemAuthor item),+        "   Item title:  " ++ (maybe "" id $ getItemTitle item),+        "   Item URI:    " ++ (maybe "" id $ getItemLink  item),+        "   Item date:   " ++ (maybe "" id $ time)]+    +    case time >>= stringToUTC of+        Just y -> do+            when (threshold < y) $ do+                whenLoud . putStrLn $ "==> New entry added to maildir."+                Maildir.add directory . itemToMail $ item +            return y+        _      -> do+            Maildir.add directory . itemToMail $ item +            return threshold++downloadRaw :: URI -> IO (Either String String)+downloadRaw uri = do+    result <- simpleHTTP . getRequest $ show uri+    return . either (Left . show) (Right . decodeIfNeeded . rspBody) $ result++-- | Same as Text.Feed.Import.ParseFeedString, but with Either monad.+parseFeedString :: String -> Either String Feed+parseFeedString = maybe+    (Left "Unable to parse XML from raw page.") +    Right +    . F.parseFeedString+

@@ -0,0 +1,33 @@+module Imm.Mail where++-- {{{ Imports+import Imm.Types+import Imm.Util++import Control.Monad++import Data.Time.Clock.POSIX++import Text.Feed.Query+import Text.Feed.Types+-- }}}++                +defaultMail :: Mail+defaultMail = Mail {+    mCharset            = "utf-8",+    mContent            = "",+    mContentDisposition = "inline",+    mDate               = posixSecondsToUTCTime 0,+    mFrom               = "imm",+    mMIME               = "text/html",+    mSubject            = "Untitled",+    mReturnPath         = "<imm@noreply>"}++ +itemToMail :: Item -> Mail+itemToMail item = defaultMail {+    mDate       = maybe (posixSecondsToUTCTime 0) id . (stringToUTC <=< getItemDate) $ item,+    mFrom       = maybe "Anonymous" id $ getItemAuthor item,+    mSubject    = maybe "Untitled" id $ getItemTitle item,+    mContent    = maybe "Empty" id $ getItemDescription item}

@@ -0,0 +1,41 @@+module Imm.Maildir where++-- {{{ Imports+import Imm.Mail()+import Imm.Types++import Data.Time.Clock.POSIX++import Network.BSD++import System.Directory+import System.FilePath+import System.IO.Error+import System.Random+-- }}}++init :: FilePath -> IO Bool+init directory = do+    root <- try $ createDirectoryIfMissing True directory+    cur  <- try . createDirectoryIfMissing True . (directory </>) $ "cur"+    new  <- try . createDirectoryIfMissing True . (directory </>) $ "new"+    tmp  <- try . createDirectoryIfMissing True . (directory </>) $ "tmp"+    +    case (root, cur, new, tmp) of+        (Right _, Right _, Right _, Right _) -> return True+        _                                    -> return False++add :: FilePath -> Mail -> IO ()+add directory mail = do+    fileName <- getUniqueName+    writeFile (directory </> "new" </> fileName) (show mail)+++getUniqueName :: IO String    +getUniqueName = do+    time     <- getPOSIXTime >>= (return . show)+    hostname <- getHostName+    rand     <- (getStdRandom $ randomR (1,100000) :: IO Int) >>= (return . show)+    +    return $ time ++ "." ++ rand ++ "." ++ hostname+

@@ -0,0 +1,7 @@+module Main where++import Imm.Core+--import Imm.Types++main :: IO ()+main = imm defaultParameters

@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Imm.Types where++-- {{{ Imports+import Network.URI++import Data.Time.Clock++import System.Console.CmdArgs++import Text.Feed.Types+-- }}}+++data CliOptions = CliOptions {+    mParameter :: Maybe String+} deriving (Data, Typeable, Show, Eq)++-- | +data Parameters = Parameters {+    mCacheDirectory :: Maybe String,+    mFeedURIs       :: [String],             -- ^ Feeds list+    mMailDirectory  :: FilePath,+    mError          :: Maybe String          -- ^ Error                                                                                                                           +}++data ImmFeed = ImmFeed {+    mURI  :: URI,+    mFeed :: Feed+}++data Mail = Mail {+    mReturnPath  :: String,+    mDate        :: UTCTime,+    mFrom        :: String,+    mSubject     :: String,+    mMIME        :: String,+    mCharset     :: String,+    mContentDisposition :: String,+    mContent     :: String+}++instance Show Mail where +    show mail = unlines [+        "Return-Path: " ++ mReturnPath mail,+        "Date: " ++ (show $ mDate mail),+        "From: " ++ mFrom mail,+        "Subject: " ++ mSubject mail,+        "Content-Type: " ++ mMIME mail ++ "; charset=" ++ mCharset mail,+        "Content-Disposition: " ++ mContentDisposition mail,+        "",+        mContent mail]

@@ -0,0 +1,24 @@+module Imm.Util where++-- {{{ Imports+import Codec.Binary.UTF8.String++import Data.Time.Clock+import Data.Time.Format++--import Network.URI++import System.Locale+-- }}}++escapeFileName :: Char -> String+escapeFileName '/' = "|"+escapeFileName x   = x:[]+    +stringToUTC :: String -> Maybe UTCTime+stringToUTC = parseTime defaultTimeLocale "%a, %e %b %Y %T %z"++decodeIfNeeded :: String -> String+decodeIfNeeded text = case isUTF8Encoded text of+    False -> text+    _     -> decodeString text

@@ -0,0 +1,13 @@+DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+Version 2, December 2004++Copyright (C) 2011 koral <koral at mailoo dot org>++Everyone is permitted to copy and distribute verbatim or modified+copies of this license document, and changing it is allowed as long+as the name is changed.++DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++0. You just DO WHAT THE FUCK YOU WANT TO.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,55 @@+Name:                imm+Version:             0.1.0.0+Synopsis:            RSS-to-maildir tool+--Description:         +--Homepage:+Category:            Web++License:             OtherLicense+License-file:        LICENSE+-- Copyright:           +Author:              kamaradclimber, koral+Maintainer:          koral att mailoo dott org++Cabal-version:       >=1.8+Build-type:          Simple+-- Extra-source-files:  ++Source-repository head+    Type:     git+    Location: git@github:k0ral/imm.git++Library+    Exposed-modules:+        Imm.Core,+        Imm.Types,+        Imm.Util,+        Imm.Mail,+        Imm.Maildir+    Build-depends:+        base == 4.*,+        directory,+        dyre,+        feed,+        filepath,+        HTTP,+        time,+        xml,+        old-locale,+        random,+        bytestring,+        mime-mail,+        text,+        cmdargs,+        network,+        utf8-string+    +    -- Other-modules:       +    -- Build-tools:         +    Ghc-options: -Wall++Executable imm+    Build-depends: imm, base == 4.*+    Main-is: Main.hs+    Hs-Source-Dirs: Imm+    Ghc-options: -Wall -threaded