light refactoring

This commit is contained in:
towards-a-new-leftypol 2023-10-07 15:04:07 -04:00
parent 8d3a2c05d0
commit d78f235c90
1 changed files with 22 additions and 20 deletions

View File

@ -93,6 +93,27 @@ createArchivesForNewBoards settings dirs archived_boards siteid = do
mapM_ putStrLn (map Boards.pathpart boards) mapM_ putStrLn (map Boards.pathpart boards)
return boards return boards
processBoard :: JSONSettings -> Boards.Board -> IO ()
processBoard settings board = do
let catalogPath = backupDir </> (Boards.pathpart board) </> "catalog.json"
putStrLn $ "catalog file path: " ++ catalogPath
result <- parseJSONFile catalogPath
case result of
Right catalogs -> do
let threads_on_board = concatMap threads catalogs
-- catalogs can be turned into [ Thread ]
-- ensureThreads :: ( Board, [ Thread ] ) -> IO ()
mapM_ (print . no) threads_on_board
Left errMsg ->
putStrLn $ "Failed to parse the JSON file in directory: "
++ (Boards.pathpart board) ++ ". Error: " ++ errMsg
where
backupDir :: FilePath
backupDir = backup_read_root settings
processBackupDirectory :: JSONSettings -> IO () processBackupDirectory :: JSONSettings -> IO ()
processBackupDirectory settings = do processBackupDirectory settings = do
@ -111,26 +132,7 @@ processBackupDirectory settings = do
let boardnames = map Boards.pathpart archived_boards let boardnames = map Boards.pathpart archived_boards
created_boards <- createArchivesForNewBoards settings dirs boardnames site_id_ created_boards <- createArchivesForNewBoards settings dirs boardnames site_id_
let boards :: [ Boards.Board ] = archived_boards ++ created_boards let boards :: [ Boards.Board ] = archived_boards ++ created_boards
return () mapM_ (processBoard settings) boards
mapM_ processDir dirs
where
backupDir :: FilePath
backupDir = backup_read_root settings
processDir dir = do
let catalogPath = backupDir </> dir </> "catalog.json"
putStrLn $ "catalog file path: " ++ catalogPath
result <- parseJSONFile catalogPath
case result of
Right catalogs ->
mapM_ (mapM_ (print . no) . threads) catalogs
Left errMsg ->
putStrLn $ "Failed to parse the JSON file in directory: "
++ dir ++ ". Error: " ++ errMsg
main :: IO () main :: IO ()
main = do main = do