diff --git a/Imm/Config.hs b/Imm/Config.hs new file mode 100644 --- /dev/null +++ b/Imm/Config.hs @@ -0,0 +1,15 @@ +module Imm.Config where + +import Imm.Types + +-- | Default configuration. +defaultParameters :: Parameters +defaultParameters = Parameters { + mCacheDirectory = Nothing, + mFeedURIs = [], + mMailDirectory = defaultMailDirectory, + mError = Nothing +} + +defaultMailDirectory :: PortableFilePath +defaultMailDirectory = const "feeds" diff --git a/Imm/Core.hs b/Imm/Core.hs --- a/Imm/Core.hs +++ b/Imm/Core.hs @@ -1,6 +1,7 @@ module Imm.Core where -- {{{ Imports +import Imm.Config import Imm.Mail import qualified Imm.Maildir as Maildir import Imm.Types @@ -15,9 +16,8 @@ import Data.Foldable --import Data.Functor --import Data.Maybe -import Data.Time.Clock +import Data.Time import Data.Time.Clock.POSIX -import Data.Time.Format import Network.HTTP hiding(Response) import Network.URI @@ -62,15 +62,6 @@ showError :: Parameters -> String -> Parameters showError parameters message = parameters { mError = Just message } - --- | Default configuration. -defaultParameters :: Parameters -defaultParameters = Parameters { - mCacheDirectory = Nothing, - mFeedURIs = [], - mMailDirectory = "rss", - mError = Nothing -} -- }}} -- | @@ -97,9 +88,7 @@ -- Initialize mailbox result <- Maildir.init directory - case result of - False -> putStrLn $ "Unable to initialize maildir at: " ++ directory - _ -> realMain' parameters + when result $ realMain' parameters -- At this point, a maildir has been setup. realMain' :: Parameters -> IO () @@ -129,9 +118,10 @@ -- oldTime <- try $ readFile (directory fileName) + let timeZero = posixSecondsToUTCTime $ 0 let threshold = either - (const $ posixSecondsToUTCTime 0) - (maybe (posixSecondsToUTCTime 0) id . parseTime defaultTimeLocale "%F %T %Z") + (const timeZero) + (maybe timeZero id . parseTime defaultTimeLocale "%F %T %Z") oldTime lastTime <- foldlM (\acc item -> processItem parameters threshold item >>= (return . (max acc))) threshold (feedItems feed) @@ -147,6 +137,7 @@ processItem :: Parameters -> UTCTime -> Item -> IO UTCTime processItem parameters@Parameters{ mMailDirectory = directory } threshold item = do currentTime <- getCurrentTime :: IO UTCTime + timeZone <- getCurrentTimeZone let time = getItemDate item whenLoud . putStr . unlines $ ["", @@ -155,14 +146,14 @@ " Item URI: " ++ (maybe "" id $ getItemLink item), " Item date: " ++ (maybe "" id $ time)] - case time >>= stringToUTC of + case time >>= parseDate of Just y -> do when (threshold < y) $ do whenLoud . putStrLn $ "==> New entry added to maildir." - Maildir.add directory . itemToMail $ item + Maildir.add directory . itemToMail timeZone $ item return y _ -> do - Maildir.add directory . itemToMail $ item + Maildir.add directory . itemToMail timeZone $ item return threshold downloadRaw :: URI -> IO (Either String String) diff --git a/Imm/Mail.hs b/Imm/Mail.hs --- a/Imm/Mail.hs +++ b/Imm/Mail.hs @@ -6,28 +6,28 @@ import Control.Monad -import Data.Time.Clock.POSIX +import Data.Time import Text.Feed.Query import Text.Feed.Types -- }}} - + defaultMail :: Mail defaultMail = Mail { mCharset = "utf-8", mContent = "", mContentDisposition = "inline", - mDate = posixSecondsToUTCTime 0, + mDate = Nothing, mFrom = "imm", mMIME = "text/html", mSubject = "Untitled", mReturnPath = ""} -itemToMail :: Item -> Mail -itemToMail item = defaultMail { - mDate = maybe (posixSecondsToUTCTime 0) id . (stringToUTC <=< getItemDate) $ item, +itemToMail :: TimeZone -> Item -> Mail +itemToMail timeZone item = defaultMail { + mDate = maybe Nothing (Just . utcToZonedTime timeZone) . parseDate <=< getItemDate $ item, mFrom = maybe "Anonymous" id $ getItemAuthor item, mSubject = maybe "Untitled" id $ getItemTitle item, mContent = maybe "Empty" id $ getItemDescription item} diff --git a/Imm/Maildir.hs b/Imm/Maildir.hs --- a/Imm/Maildir.hs +++ b/Imm/Maildir.hs @@ -3,32 +3,40 @@ -- {{{ Imports import Imm.Mail() import Imm.Types +import Imm.Util import Data.Time.Clock.POSIX import Network.BSD +import System.Console.CmdArgs import System.Directory import System.FilePath import System.IO.Error import System.Random -- }}} -init :: FilePath -> IO Bool +init :: PortableFilePath -> 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" + dir <- resolve directory + root <- try $ createDirectoryIfMissing True dir + cur <- try . createDirectoryIfMissing True . (dir ) $ "cur" + new <- try . createDirectoryIfMissing True . (dir ) $ "new" + tmp <- try . createDirectoryIfMissing True . (dir ) $ "tmp" case (root, cur, new, tmp) of - (Right _, Right _, Right _, Right _) -> return True - _ -> return False + (Right _, Right _, Right _, Right _) -> do + whenLoud . putStrLn . ("Maildir correctly created at: " ++) $ dir + return True + _ -> do + whenNormal . putStrLn . ("Unable to initialize maildir at: " ++) $ dir + return False -add :: FilePath -> Mail -> IO () +add :: PortableFilePath -> Mail -> IO () add directory mail = do + dir <- resolve directory fileName <- getUniqueName - writeFile (directory "new" fileName) (show mail) + writeFile (dir "new" fileName) (show mail) getUniqueName :: IO String diff --git a/Imm/Main.hs b/Imm/Main.hs --- a/Imm/Main.hs +++ b/Imm/Main.hs @@ -1,5 +1,6 @@ module Main where +import Imm.Config import Imm.Core --import Imm.Types diff --git a/Imm/Types.hs b/Imm/Types.hs --- a/Imm/Types.hs +++ b/Imm/Types.hs @@ -4,7 +4,8 @@ -- {{{ Imports import Network.URI -import Data.Time.Clock +import Data.Time +import Data.Time.RFC2822 import System.Console.CmdArgs @@ -20,7 +21,7 @@ data Parameters = Parameters { mCacheDirectory :: Maybe String, mFeedURIs :: [String], -- ^ Feeds list - mMailDirectory :: FilePath, + mMailDirectory :: PortableFilePath, mError :: Maybe String -- ^ Error } @@ -31,7 +32,7 @@ data Mail = Mail { mReturnPath :: String, - mDate :: UTCTime, + mDate :: Maybe ZonedTime, mFrom :: String, mSubject :: String, mMIME :: String, @@ -43,10 +44,21 @@ instance Show Mail where show mail = unlines [ "Return-Path: " ++ mReturnPath mail, - "Date: " ++ (show $ mDate mail), + maybe "" (("Date: " ++) . showRFC2822) . mDate $ mail, "From: " ++ mFrom mail, "Subject: " ++ mSubject mail, "Content-Type: " ++ mMIME mail ++ "; charset=" ++ mCharset mail, "Content-Disposition: " ++ mContentDisposition mail, "", mContent mail] + +-- | Set of reference directories, typically used to build FilePath-s +data RefDirs = RefDirs { + mHome :: FilePath, -- ^ Home directory + mTemporary :: FilePath, -- ^ Temporary files directory + mConfiguration :: FilePath, -- ^ Configuration directory + mData :: FilePath -- ^ Data directory +} + +type PortableFilePath = RefDirs -> FilePath + diff --git a/Imm/Util.hs b/Imm/Util.hs --- a/Imm/Util.hs +++ b/Imm/Util.hs @@ -1,22 +1,36 @@ module Imm.Util where -- {{{ Imports +import Imm.Types + import Codec.Binary.UTF8.String -import Data.Time.Clock -import Data.Time.Format +import Data.Maybe +import Data.Time +import Data.Time.RFC2822 +import Data.Time.RFC3339 --import Network.URI -import System.Locale +import System.Directory +import System.Environment.XDG.BaseDir -- }}} +resolve :: (RefDirs -> a) -> IO a +resolve f = do + homeDir <- getHomeDirectory + tmpDir <- getTemporaryDirectory + configDir <- getUserConfigDir "hbro" + dataDir <- getUserDataDir "hbro" + + return . f $ RefDirs homeDir tmpDir configDir dataDir + escapeFileName :: Char -> String escapeFileName '/' = "|" escapeFileName x = x:[] -stringToUTC :: String -> Maybe UTCTime -stringToUTC = parseTime defaultTimeLocale "%a, %e %b %Y %T %z" +parseDate :: String -> Maybe UTCTime +parseDate date = listToMaybe . map zonedTimeToUTC . catMaybes . map ((flip ($)) date) $ [readRFC2822, readRFC3339] decodeIfNeeded :: String -> String decodeIfNeeded text = case isUTF8Encoded text of diff --git a/imm.cabal b/imm.cabal --- a/imm.cabal +++ b/imm.cabal @@ -1,5 +1,5 @@ Name: imm -Version: 0.1.0.0 +Version: 0.1.1.0 Synopsis: RSS-to-maildir tool --Description: --Homepage: @@ -21,6 +21,7 @@ Library Exposed-modules: + Imm.Config, Imm.Core, Imm.Types, Imm.Util, @@ -28,21 +29,23 @@ Imm.Maildir Build-depends: base == 4.*, + bytestring, + cmdargs, directory, dyre, feed, filepath, HTTP, - time, - xml, + mime-mail, + network, old-locale, random, - bytestring, - mime-mail, text, - cmdargs, - network, - utf8-string + time, + timerep, + utf8-string, + xdg-basedir, + xml -- Other-modules: -- Build-tools: