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

Fix legacy style attachment file paths

This commit is contained in:
towards-a-new-leftypol 2024-04-11 14:43:15 -04:00
parent 359869984e
commit cb2da26c64
3 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/JSONParsing.hs
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

2
src/JSONPost.hs
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

12
src/Lib.hs
View File

@ -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,9 +460,9 @@ 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 thumbnail_path = (withPathPrefix "") </> (T.unpack $ board_pathpart <> "/thumb/" <> tim <> ext)
p = At.Paths file_path thumbnail_path p = At.Paths file_path thumbnail_path
@ -510,7 +510,7 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
) )
) (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