Sync - create priority queue

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,
+                      random
-                      transformers
+                      -- transformers
 
     -- Directories containing source files.
     hs-source-dirs:   src

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

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)
 

src/PriorityQueue.hs

@@ -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)]

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)
 

src/Sync.hs

@@ -2,11 +2,21 @@
 
 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
 import qualified Common.Server.JSONSettings as JS
 import qualified Network.DataClient as Client
 import qualified Lib
-import Control.Monad.Trans.Except (ExceptT, runExceptT)
+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 {..} =
@@ -31,9 +41,96 @@ syncWebsites consumer_settings = do
 
     print sites
 
-    latest_posts_per_board <- Client.getLatestPostsPerBoard json_settings
+    latest_posts_per_board_results <- Client.getLatestPostsPerBoard json_settings
 
+    case latest_posts_per_board_results of
+        Left e -> do
+            putStrLn $ "Error getting board information: " ++ show e
+            exitFailure
+        Right latest_posts_per_board -> do
             print latest_posts_per_board
+
+            let boards_per_site :: Map.Map Int [ String ] =
+                    foldl
+                        (\m b ->
+                            let key = GLPPBR.site_id b
+                                pathpart = GLPPBR.pathpart b
+                            in
+
+                            Map.insertWith (++) key [ pathpart ] m
+                        )
+                        Map.empty
+                        latest_posts_per_board
+
+            let board_id_to_last_modified = Map.fromList $
+                    map
+                        (\b -> (GLPPBR.board_id b, GLPPBR.creation_time b))
+                        latest_posts_per_board
+
+            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)
+
+                )
+                (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
+
     -- first we need all the (Site, Board) tuples ✓
     -- perhaps we even want all (Site, Board, Thread) ✓
     -- But then we don't load the posts of each thread, instead only do
@@ -48,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