fix space leak by including writing out shrunken images in paralleliz…

…ed operation

as discussed in the comment, the old approach would hold all shrunken
images in memory at once, before writing any of them to disk.  the new
approach permits each shrunken image to be written to disk as soon as
it's ready.

this source of the space leak and the solution was suggested by
claude.ai.

fixes jerith666#98

shell.nix

@@ -13,6 +13,7 @@ let
     extra
     JuicyPixels
     parallel
+    parallel-io
     regex-compat
     safe
     tasty

src/generator/elbum.cabal

@@ -71,6 +71,7 @@ executable elbum
                      , unix
                      , bytestring
                      , parallel
+                     , parallel-io
                      , extra
                      , safe
                      , base >=4.10

src/generator/gen-album.hs

@@ -15,8 +15,8 @@ import Codec.Picture.Metadata
 import qualified Codec.Picture.Types
 import qualified Codec.Picture.Types as M
 import Control.Concurrent.Async
+import Control.Concurrent.ParallelIO (parallel)
 import Control.Monad
-import Control.Parallel.Strategies
 import Data.Aeson (decode, encode)
 import qualified Data.ByteString.Lazy.Char8 as C
 import Data.Either
@@ -472,13 +472,20 @@ procImage s d (f, i) = do
 
 procSrcSet :: FilePath -> FilePath -> FilePath -> DynamicImage -> Int -> Int -> IO (ImgSrc, [ImgSrc])
 procSrcSet s d f i w h = do
-  let shrunkenSrcs = map (shrinkImgSrc s d f i w h) (sizes w) `using` parList rdeepseq
-      shrunken = map third shrunkenSrcs
   rawImg <- copyRawImgSrc s d f w h
-  -- putStrSameLn $ "processing " ++ show f ++ " "
-  mapM_ (writeShrunkenImgSrc . fstSnd) shrunkenSrcs
+  {- note: we combine shrinking the image and writing it out to disk as a single
+  parallelizable operation.  if instead we parallelize all the shrinking
+  operations first, then parallelize all the writing, we keep all the shrunken
+  images in memory at once -}
+  shrunken <- parallel $ map (shrinkAndWrite s d f i w h) (sizes w)
   return (rawImg, shrunken)
 
+shrinkAndWrite :: FilePath -> FilePath -> FilePath -> DynamicImage -> Int -> Int -> Int -> IO ImgSrc
+shrinkAndWrite s d f i w h maxwidth = do
+  let (rgbfImgSmall, fsmpath, imgSrc) = shrinkImgSrc s d f i w h maxwidth
+  writeShrunkenImgSrc (rgbfImgSmall, fsmpath)
+  return imgSrc
+
 writeShrunkenImgSrc :: (Codec.Picture.Types.Image PixelRGBF, FilePath) -> IO ()
 writeShrunkenImgSrc (ism, fsmpath) = do
   createDirectoryIfMissing True $ takeDirectory fsmpath
@@ -580,11 +587,3 @@ maybeTuple (ma, mb) =
           Nothing
     Nothing ->
       Nothing
-
-fstSnd :: (a, b, c) -> (a, b)
-fstSnd (a, b, _) =
-  (a, b)
-
-third :: (a, b, c) -> c
-third (_, _, c) =
-  c

src/generator/gen-album.nix

@@ -9,6 +9,7 @@
 , filepath
 , JuicyPixels
 , parallel
+, parallel-io
 , regex-compat
 , safe
 , tasty
@@ -30,6 +31,7 @@ mkDerivation {
     filepath
     JuicyPixels
     parallel
+    parallel-io
     regex-compat
     safe
     tasty