diff --git a/chan-delorean.cabal b/chan-delorean.cabal index 27516b6..2396872 100644 --- a/chan-delorean.cabal +++ b/chan-delorean.cabal @@ -137,6 +137,7 @@ executable chan-delorean-consoomer Common.Server.ConsumerSettings Common.Server.JSONSettings PriorityQueue + Sync -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Common b/src/Common index e67b24b..0d85d44 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit e67b24b5f1035c9096e729437579794a7677bd3a +Subproject commit 0d85d44cbb5a50b4751751d5ca61707cc1b75587 diff --git a/src/Lib.hs b/src/Lib.hs index df8fc0a..840c79b 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -683,8 +683,8 @@ processBoard settings fgs@FileGetters {..} site board = do ++ (Boards.pathpart board) ++ ". Error: " ++ errMsg -processBoards :: JSONSettings -> FileGetters -> [ FilePath ] -> IO () -processBoards settings fgs board_names = do +getBoards :: JSONSettings -> [ FilePath ] -> IO (Sites.Site, [ Boards.Board ]) +getBoards settings board_names = do site :: Sites.Site <- ensureSiteExists settings let boardsSet = Set.fromList board_names let site_id_ = Sites.site_id site @@ -700,9 +700,14 @@ processBoards settings fgs board_names = do created_boards <- createArchivesForNewBoards settings boardsSet boardnames site_id_ let boards :: [ Boards.Board ] = archived_boards ++ created_boards let boards_we_have_data_for = filter (\board -> Set.member (Boards.pathpart board) boardsSet) boards - mapM_ (processBoard settings fgs site) boards_we_have_data_for + return (site, boards_we_have_data_for) +processBoards :: JSONSettings -> FileGetters -> [ FilePath ] -> IO () +processBoards settings fgs board_names = + getBoards settings board_names >>= \(site, boards) -> + mapM_ (processBoard settings fgs site) boards + processBackupDirectory :: JSONSettings -> IO () processBackupDirectory settings = do diff --git a/src/Main.hs b/src/Main.hs index bcaba2f..fbf9b42 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -20,6 +20,7 @@ import Lib ) import qualified Network.DataClient as Client import qualified Common.AttachmentType as At +import Sync newtype CliArgs = CliArgs { settingsFile :: String @@ -105,11 +106,18 @@ processWebsite settings site_settings = do main :: IO () main = do - putStrLn "Starting channel web synchronization." - settings <- getSettings print settings - _ <- mapConcurrently (processWebsite settings) (websites settings) + _ <- if http_fill_all settings + then do + putStrLn "Starting web backfill" + mapConcurrently (processWebsite settings) (websites settings) + else return [] + + if http_sync_continously settings + then syncWebsites settings + else return () + + putStrLn "Done" - putStrLn "Done." diff --git a/src/PriorityQueue.hs b/src/PriorityQueue.hs index 2c7cced..1de30c3 100644 --- a/src/PriorityQueue.hs +++ b/src/PriorityQueue.hs @@ -16,10 +16,11 @@ module PriorityQueue , take , put , selectSkewedIndex + , main ) where -import Prelude hiding (splitAt, take) +import Prelude hiding (splitAt, take, min, max, elem) import Data.Set hiding (take, foldr, map) import Data.Ord (comparing) import System.Random (StdGen, getStdGen, randomR) @@ -81,7 +82,7 @@ main = do -- let x = fst $ take i q -- print (i, priority x) - let rs = foldr f ([], stdGen) [1..100000] + let rs = foldr f ([], stdGen) ([1..100000] :: [ Int ]) mapM_ pf $ countOccurrences $ fst rs where @@ -98,4 +99,3 @@ main = do countOccurrences :: (Eq a, Ord a) => [a] -> [(a, Int)] countOccurrences rolls = map (\x -> (head x, length x)) . group . sort $ rolls - diff --git a/src/Sync.hs b/src/Sync.hs new file mode 100644 index 0000000..bd5d904 --- /dev/null +++ b/src/Sync.hs @@ -0,0 +1,19 @@ +module Sync where + +import Common.Server.ConsumerSettings + +syncWebsites :: ConsumerJSONSettings -> IO () +syncWebsites _ = do + putStrLn "Starting channel web synchronization." + + -- first we need all the (Site, Board) tuples + -- perhaps we even want all (Site, Board, Thread) pairs + -- But then we don't load the posts of each thread, instead only do + -- that for threads which change, + -- - which means after we get all the threads + -- - enter a loop where you + -- - pick a board + -- - compare the threads online to memory + -- - load only the changed/new ones + -- - put board back +