Sync - create priority queue

This commit is contained in:
towards-a-new-leftypol 2025-02-05 05:14:24 -05:00
parent 6a557c7c5d
commit bffc851999
6 changed files with 92 additions and 19 deletions

View File

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

16
src/BoardQueueElem.hs Normal file
View File

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

View File

@ -12,5 +12,5 @@ data Board = Board
, name :: Maybe String
, pathpart :: String
, site_id :: Int
} deriving (Show, Generic, FromJSON)
} deriving (Show, Eq, Generic, FromJSON)

View File

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

View File

@ -11,5 +11,5 @@ data Site = Site
{ site_id :: Int
, name :: String
, url :: String
} deriving (Show, Generic, FromJSON)
} deriving (Show, Eq, Generic, FromJSON)

View File

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