Apply linter hints to Backfill script
This commit is contained in:
parent
8820330ff5
commit
af424fb887
|
@ -1,3 +1,6 @@
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
{-# HLINT ignore "Redundant bracket" #-}
|
||||||
|
{-# HLINT ignore "Use fromMaybe" #-}
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
@ -22,7 +25,7 @@ import qualified BoardsType as Boards
|
||||||
import qualified ThreadType as Threads
|
import qualified ThreadType as Threads
|
||||||
import qualified PostsType as Posts
|
import qualified PostsType as Posts
|
||||||
|
|
||||||
data SettingsCLI = SettingsCLI
|
newtype SettingsCLI = SettingsCLI
|
||||||
{ jsonFile :: FilePath
|
{ jsonFile :: FilePath
|
||||||
} deriving (Show, Data, Typeable)
|
} deriving (Show, Data, Typeable)
|
||||||
|
|
||||||
|
@ -42,11 +45,11 @@ listCatalogDirectories settings = do
|
||||||
excludedDirs = ["sfw", "alt", "overboard"]
|
excludedDirs = ["sfw", "alt", "overboard"]
|
||||||
|
|
||||||
hasCatalog dir = do
|
hasCatalog dir = do
|
||||||
let catalogPath = (backup_read_root settings) </> dir </> "catalog.json"
|
let catalogPath = backup_read_root settings </> dir </> "catalog.json"
|
||||||
doesFileExist catalogPath
|
doesFileExist catalogPath
|
||||||
|
|
||||||
|
|
||||||
ensureSiteExists :: JSONSettings -> IO (Int)
|
ensureSiteExists :: JSONSettings -> IO Int
|
||||||
ensureSiteExists settings = do
|
ensureSiteExists settings = do
|
||||||
sitesResult <- Client.getAllSites settings
|
sitesResult <- Client.getAllSites settings
|
||||||
|
|
||||||
|
@ -65,7 +68,7 @@ ensureSiteExists settings = do
|
||||||
putStrLn $ "Successfully created " ++ site_name settings ++ ". " ++ show site
|
putStrLn $ "Successfully created " ++ site_name settings ++ ". " ++ show site
|
||||||
return $ Sites.site_id site
|
return $ Sites.site_id site
|
||||||
Right [] -> do
|
Right [] -> do
|
||||||
putStrLn $ "Did not get new site id back from postgrest"
|
putStrLn "Did not get new site id back from postgrest"
|
||||||
exitFailure
|
exitFailure
|
||||||
Left err -> do
|
Left err -> do
|
||||||
putStrLn $ "Failed to create " ++ site_name settings
|
putStrLn $ "Failed to create " ++ site_name settings
|
||||||
|
@ -100,7 +103,7 @@ createArchivesForNewBoards settings dirsSet archived_boards siteid = do
|
||||||
exitFailure
|
exitFailure
|
||||||
Right boards -> do
|
Right boards -> do
|
||||||
putStrLn "Created the following boards:"
|
putStrLn "Created the following boards:"
|
||||||
mapM_ putStrLn (map Boards.pathpart boards)
|
mapM_ (putStrLn . Boards.pathpart) boards
|
||||||
return boards
|
return boards
|
||||||
|
|
||||||
|
|
||||||
|
@ -124,7 +127,7 @@ createArchivesForNewThreads
|
||||||
-> Boards.Board
|
-> Boards.Board
|
||||||
-> IO [ Threads.Thread ]
|
-> IO [ Threads.Thread ]
|
||||||
createArchivesForNewThreads settings all_threads archived_threads board = do
|
createArchivesForNewThreads settings all_threads archived_threads board = do
|
||||||
putStrLn $ "Creating " ++ (show $ length threads_to_create) ++ " threads."
|
putStrLn $ "Creating " ++ show (length threads_to_create) ++ " threads."
|
||||||
threads_result <- Client.postThreads settings (map (apiThreadToArchiveThread board_id) threads_to_create)
|
threads_result <- Client.postThreads settings (map (apiThreadToArchiveThread board_id) threads_to_create)
|
||||||
|
|
||||||
case threads_result of
|
case threads_result of
|
||||||
|
@ -156,7 +159,7 @@ ensureThreads settings board all_threads = do
|
||||||
putStrLn $ "Error fetching threads: " ++ show err
|
putStrLn $ "Error fetching threads: " ++ show err
|
||||||
exitFailure
|
exitFailure
|
||||||
Right archived_threads -> do
|
Right archived_threads -> do
|
||||||
putStrLn $ (show $ length archived_threads)++ " threads already exist."
|
putStrLn $ show (length archived_threads) ++ " threads already exist."
|
||||||
new_threads <- createArchivesForNewThreads settings all_threads archived_threads board
|
new_threads <- createArchivesForNewThreads settings all_threads archived_threads board
|
||||||
return $ archived_threads ++ new_threads
|
return $ archived_threads ++ new_threads
|
||||||
|
|
||||||
|
@ -173,14 +176,14 @@ readPosts settings board thread = do
|
||||||
Left err -> do
|
Left err -> do
|
||||||
putStrLn $ "Failed to parse the JSON file " ++ thread_filename ++ " error: " ++ err
|
putStrLn $ "Failed to parse the JSON file " ++ thread_filename ++ " error: " ++ err
|
||||||
return (thread, [])
|
return (thread, [])
|
||||||
Right posts_wrapper -> return $ (thread, JSONPosts.posts posts_wrapper)
|
Right posts_wrapper -> return (thread, JSONPosts.posts posts_wrapper)
|
||||||
|
|
||||||
where
|
where
|
||||||
thread_filename :: FilePath
|
thread_filename :: FilePath
|
||||||
thread_filename = backupDir </> "res" </> ((show $ Threads.board_thread_id thread) ++ ".json")
|
thread_filename = backupDir </> "res" </> (show (Threads.board_thread_id thread) ++ ".json")
|
||||||
|
|
||||||
backupDir :: FilePath
|
backupDir :: FilePath
|
||||||
backupDir = backup_read_root settings </> (Boards.pathpart board)
|
backupDir = backup_read_root settings </> Boards.pathpart board
|
||||||
|
|
||||||
|
|
||||||
ensurePosts
|
ensurePosts
|
||||||
|
|
Loading…
Reference in New Issue