From 8fcea9c84bb736489c10aecca443a3fdc8bb7076 Mon Sep 17 00:00:00 2001
From: towards-a-new-leftypol <paul_cockshott@protonmail.com>
Date: Fri, 12 Apr 2024 02:15:42 -0400
Subject: [PATCH] Explicitly make attachment thumbnail optional

---
 src/Common  |  2 +-
 src/Lib.hs  | 26 +++++++++++++++-----------
 src/Main.hs | 15 ++++++++++-----
 3 files changed, 26 insertions(+), 17 deletions(-)

diff --git a/src/Common b/src/Common
index 390165e..e67b24b 160000
--- a/src/Common
+++ b/src/Common
@@ -1 +1 @@
-Subproject commit 390165edf85e26c53f2fd53353270ee2ad4c4a38
+Subproject commit e67b24b5f1035c9096e729437579794a7677bd3a
diff --git a/src/Lib.hs b/src/Lib.hs
index f3e92e7..df8fc0a 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -312,7 +312,7 @@ copyOrMoveFiles settings fgs (site, board, thread, _, path, attachment) = do
         src :: FilePath
         src = At.file_path path
 
-        thumb_src :: FilePath
+        thumb_src :: Maybe FilePath
         thumb_src = At.thumbnail_path path
 
         dest :: FilePath
@@ -462,9 +462,10 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
             let
                 board_pathpart = T.pack $ Boards.pathpart board
                 file_path = (withPathPrefix "") </> (T.unpack $ board_pathpart <> "/src/" <> tim <> ext)
-                thumbnail_path = (withPathPrefix "") </> (T.unpack $ board_pathpart <> "/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
 
@@ -477,7 +478,7 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
                     , At.post_id = undefined
                     , At.resolution = undefined
                     , 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.file_size_bytes = size
                     , At.board_filename = tim
@@ -505,7 +506,7 @@ processFiles settings fgs tuples = do -- perfect just means that our posts have
                         , board
                         , thread
                         , 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
                         )
                     ) (zip [1..] files)
@@ -606,7 +607,7 @@ data FileGetters = FileGetters
     , getJSONPosts :: Sites.Site -> String -> IO (Either String JSONPosts.PostWrapper)
     , addPathPrefix :: String -> String
     , 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
         exists <- doesFileExist (At.file_path p)
         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
 
         if not destination_exists
@@ -631,11 +632,14 @@ localFileGetters settings = FileGetters
             then putStrLn ("Copying " ++ src) >> copyFile src dest
             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
-            then putStrLn ("Copying " ++ thumb_src) >> copyFile thumb_src thumb_dest
-            else return ()
+                    if thumb_exists
+                    then putStrLn ("Copying " ++ thumb_src) >> copyFile thumb_src thumb_dest
+                    else return ()
 
         else return ()
     }
diff --git a/src/Main.hs b/src/Main.hs
index 866a686..0db5d42 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -70,17 +70,22 @@ httpFileGetters settings = FileGetters
       -- it downloads them into a temporary file and gets that path of that.
     , attachmentPaths = \paths -> do
         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 ->
-            thumbpath >>= \tp -> do
-                return (At.Paths fp tp)
+            case m_thumbpath of
+                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
         createDirectoryIfMissing True common_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)