From 7bab7ea3f3326a97c9734cec63f31ad030812f10 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Wed, 11 Oct 2023 14:37:55 -0400 Subject: [PATCH] Change some fields to use Text, more parsing --- chan-delorean.cabal | 2 ++ src/Backfill.hs | 47 +++++++++++++++++++++++++++++--------- src/DataClient.hs | 1 + src/JSONCommonTypes.hs | 24 ++++++++++++++++++++ src/JSONParsing.hs | 51 +++++++++++++++++------------------------- src/JSONPost.hs | 34 ++++++++++++++++++++++++++++ 6 files changed, 117 insertions(+), 42 deletions(-) create mode 100644 src/JSONCommonTypes.hs create mode 100644 src/JSONPost.hs diff --git a/chan-delorean.cabal b/chan-delorean.cabal index 0a20289..cf94ad9 100644 --- a/chan-delorean.cabal +++ b/chan-delorean.cabal @@ -72,6 +72,8 @@ executable chan-delorean SitesType BoardsType ThreadType + JSONPost + JSONCommonTypes -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Backfill.hs b/src/Backfill.hs index b5cd975..4d24a75 100644 --- a/src/Backfill.hs +++ b/src/Backfill.hs @@ -1,7 +1,3 @@ --- {-# LANGUAGE DeriveDataTypeable #-} --- {-# LANGUAGE DeriveGeneric #-} --- {-# LANGUAGE OverloadedStrings #-} - module Main where import System.Exit @@ -23,6 +19,7 @@ import qualified DataClient as Client import qualified SitesType as Sites import qualified BoardsType as Boards import qualified ThreadType as Threads +import qualified JSONPost as JSONPosts data SettingsCLI = SettingsCLI { jsonFile :: FilePath @@ -163,22 +160,49 @@ ensureThreads settings board all_threads = do new_threads <- createArchivesForNewThreads settings all_threads archived_threads board return $ archived_threads ++ new_threads +readPosts :: JSONSettings -> Boards.Board -> Threads.Thread -> IO [ JSONPosts.Post ] +readPosts settings board thread = do + result <- parsePosts thread_filename + + case result of + Left err -> do + putStrLn $ "Failed to parse the JSON file " ++ thread_filename ++ " error: " ++ err + exitFailure + Right posts_wrapper -> return $ JSONPosts.posts posts_wrapper + + where + thread_filename :: FilePath + thread_filename = backupDir "res" ((show $ Threads.board_thread_id thread) ++ ".json") + + backupDir :: FilePath + backupDir = backup_read_root settings (Boards.pathpart board) + processBoard :: JSONSettings -> Boards.Board -> IO () processBoard settings board = do - let catalogPath = backupDir (Boards.pathpart board) "catalog.json" + let catalogPath = backupDir "catalog.json" putStrLn $ "catalog file path: " ++ catalogPath - result <- parseJSONFile catalogPath + result <- parseJSONCatalog catalogPath case result of Right catalogs -> do let threads_on_board = concatMap threads catalogs - new_threads <- ensureThreads settings board threads_on_board - -- catalogs can be turned into [ Thread ] - -- ensureThreads :: ( Board, [ Thread ] ) -> IO () - -- mapM_ (print . no) threads_on_board + all_threads_for_board :: [ Threads.Thread ] <- ensureThreads settings board threads_on_board + -- f :: Threads.Thread -> [ Posts.Post ] + -- for each thread we have to call a function that + -- - reads the thread under the board directory: + -- - t = backupDir "res' ((show $ no thread) ++ ".json") + -- + -- do we want an ensurethreads? + -- - then for each thread, grab the posts from json and see if they exist + -- - this might have to be done 350 times per board + -- + -- So we need a function (Threads.Thread, [ Posts.Post ]) -> ??? [ new Post type? ] + -- - why? + -- - well because the new post type will have a thread_id, which is known to be unique + -- - so we need to query the db for this same (thread_id (from Thread), no (from Post)) return () Left errMsg -> putStrLn $ "Failed to parse the JSON file in directory: " @@ -186,7 +210,7 @@ processBoard settings board = do where backupDir :: FilePath - backupDir = backup_read_root settings + backupDir = backup_read_root settings (Boards.pathpart board) processBackupDirectory :: JSONSettings -> IO () @@ -208,6 +232,7 @@ processBackupDirectory settings = do let boards :: [ Boards.Board ] = archived_boards ++ created_boards mapM_ (processBoard settings) boards + main :: IO () main = do settingsValue <- cmdArgs settingsCLI diff --git a/src/DataClient.hs b/src/DataClient.hs index 26cd70b..63f8daf 100644 --- a/src/DataClient.hs +++ b/src/DataClient.hs @@ -65,6 +65,7 @@ post settings path payload return_repr = do $ initReq putStrLn $ "posting to " ++ requestUrl + -- putStrLn $ "Payload: " ++ (LC8.unpack payload) handleHttp (httpLBS req) where diff --git a/src/JSONCommonTypes.hs b/src/JSONCommonTypes.hs new file mode 100644 index 0000000..383dab3 --- /dev/null +++ b/src/JSONCommonTypes.hs @@ -0,0 +1,24 @@ +module JSONCommonTypes + ( File (..) + ) where + +import Data.Text (Text) +import Data.Aeson (FromJSON) +import GHC.Generics + +data File = File + { id :: Text + , mime :: Text + , ext :: Text + , h :: Maybe Int + , w :: Maybe Int + , fsize :: Int + , filename :: Text + , spoiler :: Maybe Bool + , md5 :: Text + , file_path :: Text + , thumb_path :: Text + } deriving (Show, Generic) + +instance FromJSON File +--instance ToJSON File diff --git a/src/JSONParsing.hs b/src/JSONParsing.hs index 4ecccbe..92dbd60 100644 --- a/src/JSONParsing.hs +++ b/src/JSONParsing.hs @@ -1,19 +1,23 @@ module JSONParsing - ( Thread(..) - , File(..) - , Catalog(..) - , parseJSONFile + ( Thread (..) + , Catalog (..) + , parseJSONCatalog + , parsePosts ) where {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +import Data.Text (Text) import Data.Aeson import GHC.Generics import qualified Data.ByteString.Lazy as B import qualified Data.Text as T import Data.Aeson.Types (typeMismatch) +import qualified JSONPost as Post +import qualified JSONCommonTypes as J + data Cyclical = Cyclical Int deriving (Show, Generic) instance FromJSON Cyclical where @@ -27,10 +31,10 @@ instance FromJSON Cyclical where data Thread = Thread { no :: Int - , sub :: Maybe String - , com :: Maybe String - , name :: Maybe String - , capcode :: Maybe String + , sub :: Maybe Text + , com :: Maybe Text + , name :: Maybe Text + , capcode :: Maybe Text , time :: Int , omitted_posts :: Maybe Int , omitted_images:: Maybe Int @@ -40,40 +44,25 @@ data Thread = Thread , locked :: Maybe Int , cyclical :: Maybe Cyclical , last_modified :: Int - , board :: String - , files :: Maybe [File] + , board :: Text + , files :: Maybe [J.File] , resto :: Int , unique_ips :: Maybe Int } deriving (Show, Generic) -data File = File - { id :: String - , mime :: String - , ext :: String - , h :: Maybe Int - , w :: Maybe Int - , fsize :: Int - , filename :: String - , spoiler :: Maybe Bool - , md5 :: String - , file_path :: String - , thumb_path :: String - } deriving (Show, Generic) +instance FromJSON Thread +--instance ToJSON Thread data Catalog = Catalog { threads :: [Thread] , page :: Int } deriving (Show, Generic) -instance FromJSON Thread ---instance ToJSON Thread -instance FromJSON File ---instance ToJSON File instance FromJSON Catalog --instance ToJSON Catalog +parseJSONCatalog :: FilePath -> IO (Either String [Catalog]) +parseJSONCatalog path = B.readFile path >>= return . eitherDecode -parseJSONFile :: FilePath -> IO (Either String [Catalog]) -parseJSONFile path = do - jsonData <- B.readFile path - return $ eitherDecode jsonData +parsePosts :: FilePath -> IO (Either String Post.PostWrapper) +parsePosts path = B.readFile path >>= return . eitherDecode diff --git a/src/JSONPost.hs b/src/JSONPost.hs new file mode 100644 index 0000000..9a25929 --- /dev/null +++ b/src/JSONPost.hs @@ -0,0 +1,34 @@ +module JSONPost + ( Post (..) + , PostWrapper (..) + ) where + +import Data.Text (Text) +import Data.Aeson (FromJSON) +import GHC.Generics +import qualified JSONCommonTypes as J + +data Post = Post + { no :: Int + , com :: Maybe Text + , name :: Maybe Text + , time :: Int + , omitted_posts :: Maybe Int + , omitted_images :: Maybe Int + , sticky :: Maybe Int + , locked :: Maybe Int + , cyclical :: Maybe Int + , last_modified :: Int + , board :: String + , files :: Maybe [J.File] + , resto :: Int + , unique_ips :: Maybe Int + } deriving (Show, Generic) + +instance FromJSON Post + +data PostWrapper = PostWrapper + { posts :: [Post] + } deriving (Show, Generic) + +instance FromJSON PostWrapper