0
/
chan-delorean
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Getting list of threads now

This commit is contained in:
towards-a-new-leftypol 2023-10-06 14:53:39 -04:00
parent ce76a22e3d
commit 0f77c17e5c
2 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Backfill.hs
View File

@ -48,15 +48,19 @@ ensureSiteExists settings = do
putStrLn $ site_name settings ++ " already exists!" putStrLn $ site_name settings ++ " already exists!"
return $ Client.site_id site return $ Client.site_id site
Nothing -> do Nothing -> do
putStrLn "leftychan.net does not exist. Creating..." putStrLn $ site_name settings ++ " does not exist. Creating..."
postResult <- Client.postSite settings postResult <- Client.postSite settings
case postResult of case postResult of
Right site -> do Right (site:_) -> do
putStrLn $ "Successfully created " ++ site_name settings ++ ". " ++ show site putStrLn $ "Successfully created " ++ site_name settings ++ ". " ++ show site
return $ Client.site_id site return $ Client.site_id site
Right [] -> do
putStrLn $ "Did not get new site id back from postgrest"
exitFailure
Left err -> do Left err -> do
putStrLn $ "Failed to create leftychan.net. Error: " ++ show err putStrLn $ "Failed to create " ++ site_name settings
++ " Error: " ++ show err
exitFailure exitFailure
Left err -> do Left err -> do
@ -70,8 +74,15 @@ processBackupDirectory settings = do
print settings -- print the decoded JSON settings print settings -- print the decoded JSON settings
site_id_ <- ensureSiteExists settings site_id_ <- ensureSiteExists settings
dirs <- listCatalogDirectories settings dirs <- listCatalogDirectories settings
_ <- Client.getSiteBoards settings site_id_ boards_result <- Client.getSiteBoards settings site_id_
putStrLn "Boards fetched!" putStrLn "Boards fetched!"
case boards_result of
Left err -> do
putStrLn $ "Error fetching boards: " ++ show err
exitFailure
Right archived_boards -> do
print archived_boards
mapM_ putStrLn dirs mapM_ putStrLn dirs
mapM_ processDir dirs mapM_ processDir dirs
where where

6
src/DataClient.hs
View File

@ -90,10 +90,10 @@ handleHttp action = do
getSiteBoards :: T.JSONSettings -> Int -> IO (Either HttpError [ String ]) getSiteBoards :: T.JSONSettings -> Int -> IO (Either HttpError [ String ])
getSiteBoards settings site_id_ = get settings path >>= return . eitherDecodeResponse getSiteBoards settings site_id_ = get settings path >>= return . eitherDecodeResponse
where where
path = "/boards?select=name&boards.site_id=eq." ++ show site_id_ path = "/boards?select=name&site_id=eq." ++ show site_id_
postSite :: T.JSONSettings -> IO (Either HttpError SiteResponse) postSite :: T.JSONSettings -> IO (Either HttpError [SiteResponse])
postSite settings = postSite settings =
post settings "/sites" payload True >>= return . eitherDecodeResponse post settings "/sites" payload True >>= return . eitherDecodeResponse
@ -112,4 +112,4 @@ eitherDecodeResponse (Left err) = Left err
eitherDecodeResponse (Right bs) = eitherDecodeResponse (Right bs) =
case eitherDecode bs of case eitherDecode bs of
Right val -> Right val Right val -> Right val
Left err -> Left $ StatusCodeError 500 $ LC8.pack $ "Failed to decode JSON: " ++ err Left err -> Left $ StatusCodeError 500 $ LC8.pack $ "Failed to decode JSON: " ++ err ++ " " ++ (show bs)