manatee-reader-0.0.1: Manatee/Extension/Reader/ReaderBuffer.hs
-- Author: Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
--
-- Copyright (C) 2010 Andy Stewart, all rights reserved.
--
-- 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 3 of the License, or
-- 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, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Manatee.Extension.Reader.ReaderBuffer where
import Codec.Binary.UTF8.String
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import DBus.Client hiding (Signal)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Typeable
import Graphics.UI.Gtk.General.General
import Graphics.UI.Gtk.ModelView.TreeSortable
import Manatee.Core.Types
import Manatee.Extension.Reader.PageMode
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Map
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.General.STM
import Network.Curl.Download
import Text.Feed.Query
import Text.Feed.Types
import qualified Data.Map as M
data ReaderBuffer =
ReaderBuffer {readerBufferName :: String
,readerBufferClient :: Client
,readerBufferPageId :: PageId
,readerBufferMode :: PageMode
,readerBufferFeedInfos :: Map FeedName FeedInfo
,readerBufferFeedTreeItems :: TVar [FeedTreeItem]
,readerBufferFeedTreeOptions :: [(TreeItemOption, SortColumnId)]
,readerBufferFeedNavItems :: TVar (Map FeedName [FeedNavItem])
,readerBufferFeedNavOptions :: [(NavItemOption, SortColumnId)]
,readerBufferBroadcastChannel :: TChan ReaderTChanSignal
}
deriving Typeable
data ReaderTChanSignal = FeedUpdated FeedName
deriving (Show, Eq, Ord)
data Interval = Second Int
| Minute Int
| Hour Int
| Day Int
deriving (Show, Eq, Ord)
type FetchNumber = Int
type FeedUrl = String
type FeedName = String
data FeedTreeItem =
FeedTreeItem {ftiName :: String
,ftiUnreadNumber :: Int
,ftiUpdateTime :: Int
}
deriving Show
data TreeItemOption = TName
deriving (Eq, Show, Read)
class TreeItemClass a where
tiGetColumnTitle :: a -> String
tiGetCellText :: a -> FeedTreeItem -> String
tiGetCellXAlign :: a -> Float
tiCompareRow :: a -> FeedTreeItem -> FeedTreeItem -> IO Ordering
instance TreeItemClass TreeItemOption where
tiGetColumnTitle TName = "Feed"
tiGetCellText TName item = ftiName item ++ " (" ++ show (ftiUnreadNumber item) ++ ")"
tiGetCellXAlign TName = 0.0
tiCompareRow TName item1 item2 = return $ comparing ftiName item1 item2
data FeedNavItem =
FeedNavItem {fniFeedName :: String
,fniTitle :: String
,fniTime :: String
,fniUrl :: String
,fniHasRead :: Bool
}
deriving Show
data NavItemOption = NTitle | NTime
deriving (Eq, Show, Read)
class NavItemClass a where
niGetColumnTitle :: a -> String
niGetColumnMaxWidth :: a -> Maybe Int
niGetCellText :: a -> FeedNavItem -> String
niGetCellXAlign :: a -> Float
niCompareRow :: a -> FeedNavItem -> FeedNavItem -> IO Ordering
instance NavItemClass NavItemOption where
niGetColumnTitle NTitle = "Title"
niGetColumnTitle NTime = "Time"
niGetColumnMaxWidth NTitle = Just 500
niGetColumnMaxWidth NTime = Just 50
niGetCellText NTitle item = decodeString $ fniTitle item
niGetCellText NTime item = fniTime item
niGetCellXAlign NTitle = 0.0
niGetCellXAlign NTime = 0.0
niCompareRow NTitle item1 item2 = return $ comparing fniTitle item1 item2
niCompareRow NTime item1 item2 = return $ comparing fniTime item1 item2
data FeedInfo =
FeedInfo {feedUrl :: FeedUrl -- feed url
,feedInterval :: [Interval] -- interval time between retrievals
}
deriving Show
-- | Create reader buffer.
readerBufferNew :: String -> Client -> PageId -> IO ReaderBuffer
readerBufferNew path client pageId = do
buffer <- ReaderBuffer <$> pure path
<*> pure client
<*> pure pageId
<*> pure readerMode
<*> pure feedInfos
<*> newTVarIO (map (\ (name, _) -> FeedTreeItem name 0 0) $ M.toList feedInfos)
<*> pure (pairPred [TName])
<*> newTVarIO M.empty
<*> pure (pairPred [NTitle, NTime])
<*> (newTChanIO :: IO (TChan ReaderTChanSignal))
-- Fetch feed.
readerBufferFetchFeed buffer
return buffer
-- | Fetch feed.
readerBufferFetchFeed :: ReaderBuffer -> IO ()
readerBufferFetchFeed buffer@(ReaderBuffer {readerBufferFeedInfos = infos}) =
forM_ (M.toList infos) $ \ (feedName, _) ->
readerBufferUpdateFeed buffer feedName
-- | Update feed.
readerBufferUpdateFeed :: ReaderBuffer -> FeedName -> IO ()
readerBufferUpdateFeed buffer@(ReaderBuffer {readerBufferFeedInfos = infos} )
feedName = do
forkIO $
findMinMatch infos (\ name _ -> name == feedName)
?>= \ (_, FeedInfo {feedUrl = url
,feedInterval = interval}) -> do
-- Download feed.
feed <- openAsFeed url
case feed of
-- Pick feed information after download feed.
Right f -> do
putStrLn $ "Feed " ++ feedName ++ " is updated."
pickFeedInfo buffer feedName f
writeTChanIO (readerBufferBroadcastChannel buffer) (FeedUpdated feedName)
-- Or print error information.
Left err -> putStrLn err
-- Start next update cycle.
timeoutAddFull (readerBufferUpdateFeed buffer feedName >> return False)
priorityDefault
(calculateIntervalTime interval)
return ()
return ()
-- | Pick information from feed.
pickFeedInfo :: ReaderBuffer -> FeedName -> Feed -> IO ()
pickFeedInfo (ReaderBuffer {readerBufferFeedNavItems = navItems})
name feed =
modifyTVarIO navItems $ \items ->
let newNavItems =
map (\item ->
FeedNavItem name
(fromMaybe "" $ getItemTitle item)
(fromMaybe "" $ getItemDate item)
(fromMaybe "" $ getItemLink item)
False
) $ getFeedItems feed
in M.insert name newNavItems items
-- | Calculate interval time.
calculateIntervalTime :: [Interval] -> Int
calculateIntervalTime [] = 0
calculateIntervalTime (x:xs) = time + calculateIntervalTime xs
where
time = second * 1000 -- convert to millisecond
second = case x of -- convert to second
Second t -> t
Minute t -> t * 60
Hour t -> t * 60 * 60
Day t -> t * 60 * 60 * 24
-- | Temp feed information, instead with user customize option after customize system complete.
feedInfos :: Map FeedName FeedInfo
feedInfos =
M.fromList [("Planet Haskell"
,FeedInfo "http://planet.haskell.org/rss20.xml"
[Minute 30])
,("HackageDB recent additions"
,FeedInfo "http://hackage.haskell.org/packages/archive/recent.rss"
[Minute 20])
,("Planet Emacsen"
,FeedInfo "http://planet.emacsen.org/atom.xml"
[Minute 20])
,("Yeeyan-Science"
,FeedInfo "http://feed.feedsky.com/yeeyan-science"
[Minute 20])
,("Yeeyan-Tech"
,FeedInfo "http://feed.feedsky.com/yeeyan-tech"
[Minute 20])
-- ,("Google Arcanum"
-- ,FeedInfo "http://rss.guao.cc/aggregator/rss"
-- [Minute 20])
]