diff --git a/chan-delorean.cabal b/chan-delorean.cabal index 219af2c..64a8722 100644 --- a/chan-delorean.cabal +++ b/chan-delorean.cabal @@ -141,6 +141,7 @@ executable chan-delorean-consoomer Common.Server.JSONSettings PriorityQueue Sync + BoardQueueElem -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -166,8 +167,8 @@ executable chan-delorean-consoomer async, temporary, stm, - random, - transformers + random + -- transformers -- Directories containing source files. hs-source-dirs: src diff --git a/src/BoardQueueElem.hs b/src/BoardQueueElem.hs new file mode 100644 index 0000000..d91bf16 --- /dev/null +++ b/src/BoardQueueElem.hs @@ -0,0 +1,16 @@ +module BoardQueueElem where + +import Data.Time.Clock (UTCTime) + +import SitesType (Site) +import BoardsType (Board) + +data BoardQueueElem = BoardQueueElem + { site :: Site + , board :: Board + , last_modified :: UTCTime + } deriving (Show, Eq) + +instance Ord BoardQueueElem where + (<=) :: BoardQueueElem -> BoardQueueElem -> Bool + a <= b = last_modified a >= last_modified b diff --git a/src/BoardsType.hs b/src/BoardsType.hs index 420a69a..a35fc12 100644 --- a/src/BoardsType.hs +++ b/src/BoardsType.hs @@ -12,5 +12,5 @@ data Board = Board , name :: Maybe String , pathpart :: String , site_id :: Int - } deriving (Show, Generic, FromJSON) + } deriving (Show, Eq, Generic, FromJSON) diff --git a/src/PriorityQueue.hs b/src/PriorityQueue.hs index 7935369..8e0dc5a 100644 --- a/src/PriorityQueue.hs +++ b/src/PriorityQueue.hs @@ -32,7 +32,7 @@ data Elem a = Elem , element :: a } -instance Ord (Elem a) where +instance Ord (Elem a) where compare = comparing priority @@ -40,17 +40,17 @@ instance Eq (Elem a) where (==) x y = priority x == priority y -type Queue a = Set (Elem a) +type Queue a = Set a -take :: Int -> Queue a -> (Elem a, Queue a) +take :: (Ord a) => Int -> Queue a -> (a, Queue a) take n set = let (_, greater) = splitAt (size set - n - 1) set elem = findMin greater in (elem, delete elem set) -put :: Elem a -> Queue a -> Queue a +put :: (Ord a) => a -> Queue a -> Queue a put = insert @@ -93,7 +93,7 @@ main = do let (x, newgen) = selectSkewedIndex (size q) gen in (x:xs, newgen) - q :: Queue Int + q :: Queue (Elem Int) q = fromList [ Elem i undefined | i <- [1..100] ] countOccurrences :: (Eq a, Ord a) => [a] -> [(a, Int)] diff --git a/src/SitesType.hs b/src/SitesType.hs index d83acb9..f98421b 100644 --- a/src/SitesType.hs +++ b/src/SitesType.hs @@ -11,5 +11,5 @@ data Site = Site { site_id :: Int , name :: String , url :: String - } deriving (Show, Generic, FromJSON) + } deriving (Show, Eq, Generic, FromJSON) diff --git a/src/Sync.hs b/src/Sync.hs index 9a5f9c3..2f8129e 100644 --- a/src/Sync.hs +++ b/src/Sync.hs @@ -5,6 +5,7 @@ module Sync where import System.Exit (exitFailure) import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Maybe (mapMaybe) -- import Control.Monad.Trans.Except (ExceptT, runExceptT) import qualified Common.Server.ConsumerSettings as S @@ -13,6 +14,9 @@ import qualified Network.DataClient as Client import qualified Lib import qualified Network.GetLatestPostsPerBoardResponse as GLPPBR import qualified SitesType as Site +import qualified BoardsType as Board +import qualified BoardQueueElem as QE +import qualified PriorityQueue as PQ consumerSettingsToPartialJSONSettings :: S.ConsumerJSONSettings -> JS.JSONSettings consumerSettingsToPartialJSONSettings S.ConsumerJSONSettings {..} = @@ -58,20 +62,72 @@ syncWebsites consumer_settings = do Map.empty latest_posts_per_board - let site_name_to_site_id :: Map.Map String Int = Map.fromList $ map (\s -> (Site.name s, Site.site_id s)) sites + let board_id_to_last_modified = Map.fromList $ + map + (\b -> (GLPPBR.board_id b, GLPPBR.creation_time b)) + latest_posts_per_board - mapM_ - (\site_settings -> - let s_id = (Map.!) site_name_to_site_id (S.name site_settings) in + let site_name_to_site :: Map.Map String Site.Site = + Map.fromList $ map (\s -> (Site.name s, s)) sites + + let site_id_board_id_to_glppbr = Map.fromList $ + map + (\b -> ((GLPPBR.site_id b, GLPPBR.pathpart b), b)) + latest_posts_per_board + + site_and_board_list_ <- mapM + (\site_settings -> do + let site = (Map.!) site_name_to_site (S.name site_settings) + let s_id = Site.site_id site + + let existing_board_info = + mapMaybe + (\board_pathpart -> + Map.lookup (s_id, board_pathpart) site_id_board_id_to_glppbr + ) + (S.boards site_settings) + + let existing_boards = + map + (\b -> Board.Board + { Board.board_id = GLPPBR.board_id b + , Board.name = Nothing + , Board.pathpart = GLPPBR.pathpart b + , Board.site_id = GLPPBR.site_id b + } + ) + existing_board_info + + boards <- Lib.createArchivesForNewBoards + (Lib.toClientSettings consumer_settings site_settings) + (Set.fromList $ S.boards site_settings) + ((Map.!) boards_per_site s_id) + s_id + + return (site, existing_boards ++ boards) - Lib.createArchivesForNewBoards - (Lib.toClientSettings consumer_settings site_settings) - (Set.fromList $ S.boards site_settings) - ((Map.!) boards_per_site s_id) - s_id ) (S.websites consumer_settings) + let site_and_board_list = concatMap (\(a, bs) -> map (\b -> (a, b)) bs) site_and_board_list_ + + let queue_elems = + map + (\(site, board) -> QE.BoardQueueElem + { QE.site = site + , QE.board = board + , QE.last_modified = + (Map.!) + board_id_to_last_modified + (Board.board_id board) + } + ) + site_and_board_list + + let pq :: PQ.Queue QE.BoardQueueElem = Set.fromList queue_elems + + print pq + -- we have our boards last modified timestamps -- get list of boards per site @@ -89,7 +145,7 @@ syncWebsites consumer_settings = do -- NEW TODO: -- - ensure that sites in the settings exist in the database! ✓ - -- - ensure that boards per site in the settings exist in the database! + -- - ensure that boards per site in the settings exist in the database! ✓ -- - finish using ExceptT and use sites, latest_posts_per_board to populate -- our PriorityQueue -- - write event loop that