Compare commits

...

2 Commits

5 changed files with 33 additions and 24 deletions

@ -1 +1 @@
Subproject commit 390165edf85e26c53f2fd53353270ee2ad4c4a38 Subproject commit e67b24b5f1035c9096e729437579794a7677bd3a

View File

@ -32,7 +32,7 @@ data Thread = Thread
, locked :: Maybe Int , locked :: Maybe Int
, cyclical :: Maybe J.Cyclical , cyclical :: Maybe J.Cyclical
, last_modified :: Int , last_modified :: Int
, board :: Text -- , board :: Text
, files :: Maybe [J.File] , files :: Maybe [J.File]
, resto :: Int , resto :: Int
, unique_ips :: Maybe Int , unique_ips :: Maybe Int

View File

@ -23,7 +23,7 @@ data Post = Post
, cyclical :: Maybe J.Cyclical , cyclical :: Maybe J.Cyclical
, last_modified :: Int , last_modified :: Int
, embed :: Maybe Text , embed :: Maybe Text
, board :: Text -- , board :: Text
, files :: Maybe [J.File] , files :: Maybe [J.File]
, resto :: Int , resto :: Int
, unique_ips :: Maybe Int , unique_ips :: Maybe Int

View File

@ -312,7 +312,7 @@ copyOrMoveFiles settings fgs (site, board, thread, _, path, attachment) = do
src :: FilePath src :: FilePath
src = At.file_path path src = At.file_path path
thumb_src :: FilePath thumb_src :: Maybe FilePath
thumb_src = At.thumbnail_path path thumb_src = At.thumbnail_path path
dest :: FilePath dest :: FilePath
@ -451,8 +451,8 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
, At.phash = phash , At.phash = phash
} }
parseLegacyPaths :: JSONPosts.Post -> Maybe (At.Paths, At.Attachment) parseLegacyPaths :: Boards.Board -> JSONPosts.Post -> Maybe (At.Paths, At.Attachment)
parseLegacyPaths post = do parseLegacyPaths board post = do
tim <- JSONPosts.tim post tim <- JSONPosts.tim post
ext <- JSONPosts.ext post ext <- JSONPosts.ext post
filename <- JSONPosts.filename post filename <- JSONPosts.filename post
@ -460,11 +460,12 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
spoiler <- JSONPosts.fsize post spoiler <- JSONPosts.fsize post
let let
board = JSONPosts.board post board_pathpart = T.pack $ Boards.pathpart board
file_path = withPathPrefix $ board <> "/src/" <> tim <> ext file_path = (withPathPrefix "") </> (T.unpack $ board_pathpart <> "/src/" <> tim <> ext)
thumbnail_path = withPathPrefix $ board <> "/thumb/" <> tim <> ext thumb_extension = "png"
thumbnail_path = (withPathPrefix "") </> (T.unpack $ board_pathpart <> "/thumb/" <> tim <> "." <> thumb_extension)
p = At.Paths file_path thumbnail_path p = At.Paths file_path (Just thumbnail_path)
mime = getMimeType ext mime = getMimeType ext
@ -477,7 +478,7 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
, At.post_id = undefined , At.post_id = undefined
, At.resolution = undefined , At.resolution = undefined
, At.file_extension = Just $ T.drop 1 ext , At.file_extension = Just $ T.drop 1 ext
, At.thumb_extension = Just $ "png" , At.thumb_extension = Just $ thumb_extension
, At.original_filename = Just $ filename <> ext , At.original_filename = Just $ filename <> ext
, At.file_size_bytes = size , At.file_size_bytes = size
, At.board_filename = tim , At.board_filename = tim
@ -505,12 +506,12 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
, board , board
, thread , thread
, q , q
, At.Paths (withPathPrefix $ JS.file_path x) (withPathPrefix $ JS.thumb_path x) , At.Paths (withPathPrefix $ JS.file_path x) (Just $ withPathPrefix $ JS.thumb_path x)
, fileToAttachment i q x , fileToAttachment i q x
) )
) (zip [1..] files) ) (zip [1..] files)
Nothing -> Nothing ->
case parseLegacyPaths p of case parseLegacyPaths board p of
Nothing -> [] Nothing -> []
Just (paths, a) -> Just (paths, a) ->
let let
@ -606,7 +607,7 @@ data FileGetters = FileGetters
, getJSONPosts :: Sites.Site -> String -> IO (Either String JSONPosts.PostWrapper) , getJSONPosts :: Sites.Site -> String -> IO (Either String JSONPosts.PostWrapper)
, addPathPrefix :: String -> String , addPathPrefix :: String -> String
, attachmentPaths :: At.Paths -> IO (Maybe At.Paths) , attachmentPaths :: At.Paths -> IO (Maybe At.Paths)
, copyOrMove :: String -> (String, String) -> (String, String) -> IO () , copyOrMove :: String -> (String, String) -> (Maybe String, String) -> IO ()
} }
@ -618,7 +619,7 @@ localFileGetters settings = FileGetters
, attachmentPaths = \p -> do , attachmentPaths = \p -> do
exists <- doesFileExist (At.file_path p) exists <- doesFileExist (At.file_path p)
if exists then return (Just p) else return Nothing if exists then return (Just p) else return Nothing
, copyOrMove = \common_dest (src, dest) (thumb_src, thumb_dest) -> do , copyOrMove = \common_dest (src, dest) (m_thumb_src, thumb_dest) -> do
destination_exists <- doesFileExist dest destination_exists <- doesFileExist dest
if not destination_exists if not destination_exists
@ -631,11 +632,14 @@ localFileGetters settings = FileGetters
then putStrLn ("Copying " ++ src) >> copyFile src dest then putStrLn ("Copying " ++ src) >> copyFile src dest
else return () else return ()
thumb_exists <- doesFileExist thumb_src case m_thumb_src of
Nothing -> return ()
Just thumb_src -> do
thumb_exists <- doesFileExist thumb_src
if thumb_exists if thumb_exists
then putStrLn ("Copying " ++ thumb_src) >> copyFile thumb_src thumb_dest then putStrLn ("Copying " ++ thumb_src) >> copyFile thumb_src thumb_dest
else return () else return ()
else return () else return ()
} }

View File

@ -70,17 +70,22 @@ httpFileGetters settings = FileGetters
-- it downloads them into a temporary file and gets that path of that. -- it downloads them into a temporary file and gets that path of that.
, attachmentPaths = \paths -> do , attachmentPaths = \paths -> do
filepath <- Client.getFile (At.file_path paths) filepath <- Client.getFile (At.file_path paths)
thumbpath <- Client.getFile (At.thumbnail_path paths) m_thumbpath <- case At.thumbnail_path paths of
Nothing -> return Nothing
Just thumbpath -> Client.getFile thumbpath
return $ filepath >>= \fp -> return $ filepath >>= \fp ->
thumbpath >>= \tp -> do case m_thumbpath of
return (At.Paths fp tp) Nothing -> return (At.Paths fp Nothing)
tp -> return (At.Paths fp tp)
, copyOrMove = \common_dest (src, dest) (thumb_src, thumb_dest) -> do , copyOrMove = \common_dest (src, dest) (m_thumb_src, thumb_dest) -> do
putStrLn $ "Copy Or Move (Move) src: " ++ src ++ " dest: " ++ dest putStrLn $ "Copy Or Move (Move) src: " ++ src ++ " dest: " ++ dest
createDirectoryIfMissing True common_dest createDirectoryIfMissing True common_dest
moveFile src dest moveFile src dest
moveFile thumb_src thumb_dest case m_thumb_src of
Nothing -> return ()
Just thumb_src -> moveFile thumb_src thumb_dest
} }
httpGetJSON :: (FromJSON a) => Sites.Site -> String -> IO (Either String a) httpGetJSON :: (FromJSON a) => Sites.Site -> String -> IO (Either String a)