From 8905383e2d17e2adb4097e1ce2e7f90ab9ceb5f5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 10:58:00 +0200
Subject: compiler: split ItemProcessors, FileProcessors and Caching

---
 compiler/src/Caching.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 compiler/src/Caching.hs

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

diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
new file mode 100644
index 0000000..b2b1ee1
--- /dev/null
+++ b/compiler/src/Caching.hs
@@ -0,0 +1,56 @@
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+module Caching
+  ( Cache
+  , skipCache
+  , withCache
+  ) where
+
+
+import Control.Monad (when)
+import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
+
+import FileProcessors (FileProcessor)
+import Files
+
+
+type Cache = FileProcessor -> FileProcessor
+
+skipCache :: Cache
+skipCache processor inputPath outputPath =
+  removePathForcibly outputPath
+  >> processor inputPath outputPath
+
+withCache :: Cache
+withCache processor inputPath outputPath =
+  do
+    isDir <- doesDirectoryExist outputPath
+    when isDir $ removePathForcibly outputPath
+
+    fileExists <- doesFileExist outputPath
+    if fileExists then
+      do
+        needUpdate <- isOutdated True inputPath outputPath
+        if needUpdate then update else skip
+    else
+      update
+
+  where
+    update = processor inputPath outputPath
+    skip = putStrLn $ "Skipping:\t" ++ outputPath
-- 
cgit v1.2.3


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/Caching.hs | 52 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 36 insertions(+), 16 deletions(-)

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

diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
index b2b1ee1..c2b5a43 100644
--- a/compiler/src/Caching.hs
+++ b/compiler/src/Caching.hs
@@ -18,39 +18,59 @@
 
 module Caching
   ( Cache
-  , skipCache
-  , withCache
+  , noCache
+  , ItemCache
+  , buildItemCache
+  , useCached
   ) where
 
 
 import Control.Monad (when)
+import qualified Data.Map.Strict as Map
 import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
 
 import FileProcessors (FileProcessor)
+import Resource (GalleryItem(..), flattenGalleryTree)
 import Files
 
 
-type Cache = FileProcessor -> FileProcessor
+type Cache a = FileProcessor a -> FileProcessor a
 
-skipCache :: Cache
-skipCache processor inputPath outputPath =
-  removePathForcibly outputPath
-  >> processor inputPath outputPath
 
-withCache :: Cache
-withCache processor inputPath outputPath =
+noCache :: Cache a
+noCache processor itemPath resPath inputFsPath outputFsPath =
+  removePathForcibly outputFsPath
+  >> processor itemPath resPath inputFsPath outputFsPath
+
+
+type ItemCache = Path -> Maybe GalleryItem
+
+buildItemCache :: Maybe GalleryItem -> ItemCache
+buildItemCache cachedItems = lookupCache
+  where
+    withKey item = (webPath $ Resource.path item, item)
+    cachedItemList = maybe [] flattenGalleryTree cachedItems
+    cachedMap = Map.fromList (map withKey cachedItemList)
+    lookupCache path = Map.lookup (webPath path) cachedMap
+
+useCached :: ItemCache -> (GalleryItem -> a) -> Cache a
+useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
   do
-    isDir <- doesDirectoryExist outputPath
-    when isDir $ removePathForcibly outputPath
+    isDir <- doesDirectoryExist outputFsPath
+    when isDir $ removePathForcibly outputFsPath
 
-    fileExists <- doesFileExist outputPath
+    fileExists <- doesFileExist outputFsPath
     if fileExists then
       do
-        needUpdate <- isOutdated True inputPath outputPath
-        if needUpdate then update else skip
+        needUpdate <- isOutdated True inputFsPath outputFsPath
+        case (needUpdate, cache itemPath) of
+          (False, Just props) -> fromCache props
+          _ -> update
     else
       update
 
   where
-    update = processor inputPath outputPath
-    skip = putStrLn $ "Skipping:\t" ++ outputPath
+    update = processor itemPath resPath inputFsPath outputFsPath
+    fromCache props =
+      putStrLn ("From cache:\t" ++ outputFsPath)
+      >> return (propGetter props)
-- 
cgit v1.2.3