module Imm.Main where
import Imm.Feed
import qualified Imm.Mail as Mail
import qualified Imm.Maildir as Maildir
import Imm.Types
import Imm.Util
import Control.Conditional hiding(when)
import Control.Monad hiding(forM_, mapM_)
import Control.Monad.Error hiding(forM_, mapM_)
import Control.Monad.Reader hiding(forM_, mapM_)
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy as T
import Data.Either
import Data.Foldable
import Data.Time
import Data.Time.Clock.POSIX
import Network.Browser hiding(request)
import Network.HTTP
import Network.URI hiding(parseURI)
import Prelude hiding(mapM_)
import System.Directory
import Text.Feed.Query hiding(getItemDate)
import Text.Feed.Types
printFeedGroupStatus :: (MonadReader Settings m, MonadIO m) => FeedGroup -> m ()
printFeedGroupStatus (settings, feeds) = do
maildir <- resolve $ mMaildir settings
io . putStrLn $ " => Feed group " ++ maildir
mapM_ printFeedStatus feeds
printFeedStatus :: (MonadReader Settings m, MonadIO m) => String -> m ()
printFeedStatus feedUri = do
prefix <- case parseURI feedUri of
Right uri -> do
lastCheck <- getLastCheck uri
return $ (lastCheck == posixSecondsToUTCTime 0) ? "[NEW] " ?? ("[Last update: "++ show lastCheck ++ "]")
_ -> return "[Not an URI]"
io . putStrLn $ prefix ++ " " ++ feedUri
checkFeedGroup :: (MonadReader Settings m, MonadIO m) => FeedGroup -> m ()
checkFeedGroup (settings, feeds) = return ()
main :: (MonadReader Settings m, MonadIO m, MonadError ImmError m) => m ()
main = do
checkStateDirectory
asks mFeedGroups >>= mapM_ (\x -> processFeedGroup x `catchError` (io . print))
checkStateDirectory :: (MonadReader Settings m, MonadIO m, MonadError ImmError m) => m ()
checkStateDirectory = asks mStateDirectory >>= resolve >>= try . io . createDirectoryIfMissing True
processFeedGroup :: (MonadIO m, MonadReader Settings m, MonadError ImmError m) => FeedGroup -> m ()
processFeedGroup _feedGroup@(config, feedURIs) = do
Maildir.init $ mMaildir config
forM_ feedURIs $ \uri ->
(parseURI uri >>= downloadFeed >>= processFeed config)
`catchError` (io . print)
processFeed :: (MonadReader Settings m, MonadIO m, MonadError ImmError m) => FeedSettings -> ImmFeed -> m ()
processFeed feedSettings (uri, feed) = do
logVerbose $ unlines [
"Processing feed: " ++ show uri,
"Title: " ++ (getFeedTitle feed),
"Author: " ++ (maybe "No author" id $ getFeedAuthor feed),
"Home: " ++ (maybe "No home" id $ getFeedHome feed)]
lastCheck <- getLastCheck uri
forM_ (feedItems feed) $ \item ->
do
date <- getItemDate item
when (date > lastCheck) $ processItem feedSettings (item, feed)
`catchError` (io . print)
storeLastCheck uri =<< io getCurrentTime
processItem :: (MonadReader Settings m, MonadIO m, MonadError ImmError m) => FeedSettings -> (Item, Feed) -> m ()
processItem feedSettings (item, feed) = do
date <- getItemDate item
logVerbose $ unlines [
" Item author: " ++ (maybe "" id $ getItemAuthor item),
" Item title: " ++ (maybe "" id $ getItemTitle item),
" Item URI: " ++ (maybe "" id $ getItemLink item),
" Item date: " ++ show date]
timeZone <- io getCurrentTimeZone
Maildir.add dir =<< Mail.build timeZone (item, feed)
where
dir = mMaildir feedSettings
downloadRaw :: (MonadIO m, MonadError ImmError m) => URI -> m B.ByteString
downloadRaw uri = do
logVerbose $ "Downloading " ++ show uri
(_, r) <- io . browse $ do
setAllowRedirects True
request (mkRequest GET uri :: Request B.ByteString)
when (rspCode r == (4,0,4)) $ throwError (HTTPError $ rspReason r)
return . rspBody $ r
downloadFeed :: (MonadIO m, MonadError ImmError m) => URI -> m ImmFeed
downloadFeed uri = do
feed <- parseFeedString . T.unpack =<< decodeUtf8 =<< downloadRaw uri
return (uri, feed)