Change some fields to use Text, more parsing

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:

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
+            all_threads_for_board :: [ Threads.Thread ] <- ensureThreads settings board threads_on_board
-            -- catalogs can be turned into [ Thread ]
+            -- f :: Threads.Thread -> [ Posts.Post ]
-            -- ensureThreads :: ( Board, [ Thread ] ) -> IO ()
+            -- for each thread we have to call a function that
-            -- mapM_ (print . no) threads_on_board
+            --  - 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

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

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

src/JSONParsing.hs

@@ -1,19 +1,23 @@
 module JSONParsing
-    ( Thread(..)
+    ( Thread (..)
-    , File(..)
+    , Catalog (..)
-    , Catalog(..)
+    , parseJSONCatalog
-    , parseJSONFile
+    , 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
+  , sub           :: Maybe Text
-  , com           :: Maybe String
+  , com           :: Maybe Text
-  , name          :: Maybe String
+  , name          :: Maybe Text
-  , capcode       :: Maybe String
+  , 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
+  , board         :: Text
-  , files         :: Maybe [File]
+  , files         :: Maybe [J.File]
   , resto         :: Int
   , unique_ips    :: Maybe Int
   } deriving (Show, Generic)
 
-data File = File
+instance FromJSON Thread
-  { id         :: String
+--instance ToJSON Thread
-  , 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)
 
 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])
+parsePosts :: FilePath -> IO (Either String Post.PostWrapper)
-parseJSONFile path = do
+parsePosts path = B.readFile path >>= return . eitherDecode
-    jsonData <- B.readFile path
-    return $ eitherDecode jsonData

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