From 52abb806a3bde6eb69d64564d971efae2cbfda24 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 15 Jun 2020 04:46:11 +0200
Subject: compiler: reuse derived item properties from last compilation

A benchmark on an already bulit gallery with ~600 pictures shows a ~90% speedup:

Before:

  Time (mean ± σ):      2.879 s ±  0.125 s    [User: 14.686 s, System: 5.511 s]
  Range (min … max):    2.774 s …  3.203 s    10 runs

After:

  Time (mean ± σ):     289.5 ms ±  15.1 ms    [User: 596.1 ms, System: 359.3 ms]
  Range (min … max):   272.8 ms … 323.0 ms    10 runs

GitHub: closes #97
---
 compiler/src/Resource.hs | 38 ++++++++++++++++++++++++--------------
 1 file changed, 24 insertions(+), 14 deletions(-)

(limited to 'compiler/src/Resource.hs')

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index fa139e0..6b4b44c 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -17,9 +17,15 @@
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Resource
-  ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
-  , buildGalleryTree, galleryCleanupResourceDir
+  ( ItemProcessor
+  , GalleryItem(..)
+  , GalleryItemProps(..)
+  , Resolution(..)
+  , Resource(..)
+  , Thumbnail(..)
+  , buildGalleryTree
+  , galleryCleanupResourceDir
+  , flattenGalleryTree
   ) where
 
 
@@ -115,12 +121,14 @@ data GalleryItem = GalleryItem
   } deriving (Generic, Show, ToJSON, FromJSON)
 
 
-type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
+type ItemProcessor a =
+     Path -- Item path
+  -> Path -- Resource Path
+  -> IO a
 
 
 buildGalleryTree ::
-     ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig
+     ItemProcessor GalleryItemProps -> ItemProcessor (Maybe Thumbnail) -> TagsFromDirectoriesConfig
   -> InputTree -> IO GalleryItem
 buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
   mkGalleryItem []
@@ -128,29 +136,31 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
     mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
     mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} =
       do
-        properties <- processItem path
-        processedThumbnail <- processThumbnail path
+        let itemPath = "/" /> path
+        properties <- processItem itemPath path
+        processedThumbnail <- processThumbnail itemPath path
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path)
-          , path = "/" /> path
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = properties }
 
     mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} =
       do
+        let itemPath = "/" /> path
         let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
         processedItems <- parallel $ map (mkGalleryItem dirTags) items
-        processedThumbnail <- maybeThumbnail dirThumbnailPath
+        processedThumbnail <- maybeThumbnail itemPath dirThumbnailPath
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
                                               ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique (aggregateTags processedItems ++ parentDirTags path)
-          , path = "/" /> path
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
 
@@ -170,9 +180,9 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
     aggregateTags :: [GalleryItem] -> [Tag]
     aggregateTags = concatMap (\item -> tags (item::GalleryItem))
 
-    maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
-    maybeThumbnail Nothing = return Nothing
-    maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
+    maybeThumbnail :: Path -> Maybe Path -> IO (Maybe Thumbnail)
+    maybeThumbnail _ Nothing = return Nothing
+    maybeThumbnail itemPath (Just thumbnailPath) = processThumbnail itemPath thumbnailPath
 
     mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime
     mostRecentModTime =
-- 
cgit v1.2.3