From 00c6216259d8a7b131307953ba5000d2b5dc564b Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 00:06:18 +0200
Subject: compiler: trivial code simplifications

Following HLint's advice.
---
 compiler/src/Compiler.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

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

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 749872d..2bb27f9 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -81,16 +81,16 @@ writeJSON outputPath object =
 (|||) = liftM2 (||)
 
 anyPattern :: [String] -> String -> Bool
-anyPattern patterns string = any (flip Glob.match string) (map Glob.compile patterns)
+anyPattern patterns string = any (flip Glob.match string . Glob.compile) patterns
 
 galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool
 galleryDirFilter config excludedCanonicalDirs =
       (not . isHidden)
   &&& (not . isExcludedDir)
-  &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
-       (matchesFile $ anyPattern $ includedFiles config))
-  &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
-              (matchesFile $ anyPattern $ excludedFiles config)))
+  &&& (matchesDir (anyPattern $ includedDirectories config) |||
+       matchesFile (anyPattern $ includedFiles config))
+  &&& (not . (matchesDir (anyPattern $ excludedDirectories config) |||
+              matchesFile (anyPattern $ excludedFiles config)))
 
   where
     matchesDir :: (FileName -> Bool) -> FSNode -> Bool
@@ -102,17 +102,17 @@ galleryDirFilter config excludedCanonicalDirs =
     matchesFile _ Dir{} = False
 
     isExcludedDir :: FSNode -> Bool
-    isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs
+    isExcludedDir Dir{canonicalPath} = canonicalPath `elem` excludedCanonicalDirs
     isExcludedDir File{} = False
 
 inputTreeFilter :: GalleryConfig -> InputTree -> Bool
 inputTreeFilter GalleryConfig{includedTags, excludedTags} =
-      (hasTagMatching $ anyPattern includedTags)
-  &&& (not . (hasTagMatching $ anyPattern excludedTags))
+      hasTagMatching (anyPattern includedTags)
+  &&& (not . hasTagMatching (anyPattern excludedTags))
 
   where
     hasTagMatching :: (String -> Bool) -> InputTree -> Bool
-    hasTagMatching cond = (any cond) . (fromMaybe [""] . tags) . sidecar
+    hasTagMatching cond = any cond . (fromMaybe [""] . tags) . sidecar
 
 
 compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO ()
-- 
cgit v1.2.3


From ce2210e6deff1d981186b6d7ddb1176f27e41f49 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 13 Jun 2020 03:41:39 +0200
Subject: compiler: make GalleryIndex loadable from JSON

---
 compiler/src/Compiler.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

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

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 2bb27f9..5a7632d 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -29,7 +29,7 @@ import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
 import System.Directory (canonicalizePath)
 
-import Data.Aeson (ToJSON)
+import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import Config
@@ -64,7 +64,7 @@ thumbnailsDir = "thumbnails"
 data GalleryIndex = GalleryIndex
   { properties :: ViewerConfig
   , tree :: GalleryItem
-  } deriving (Generic, Show, ToJSON)
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 writeJSON :: ToJSON a => FileName -> a -> IO ()
-- 
cgit v1.2.3


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/Compiler.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

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

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5a7632d..92e6ed6 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -43,9 +43,8 @@ import Files
   , nodeName
   , filterDir
   , ensureParentDir )
-import Processors
-  ( itemFileProcessor, thumbnailFileProcessor
-  , skipCached, withCached )
+import ItemProcessors (itemFileProcessor, thumbnailFileProcessor)
+import Caching (skipCache, withCache)
 
 
 defaultGalleryConf :: String
@@ -127,7 +126,7 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     inputTree <- readInputTree sourceTree
     let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
 
-    let cache = if rebuildAll then skipCached else withCached
+    let cache = if rebuildAll then skipCache else withCache
     let itemProc = itemProcessor config cache
     let thumbnailProc = thumbnailProcessor config cache
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
-- 
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/Compiler.hs | 51 ++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 43 insertions(+), 8 deletions(-)

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

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 92e6ed6..1ec55c5 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -24,17 +24,25 @@ module Compiler
 
 import GHC.Generics (Generic)
 import Control.Monad (liftM2, when)
+import Data.Bool (bool)
 import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
-import System.Directory (canonicalizePath)
+import System.Directory (canonicalizePath, doesFileExist)
 
 import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
 import Config
 import Input (InputTree, readInputTree, filterInputTree, sidecar, tags)
-import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
+import Resource
+  ( GalleryItem
+  , GalleryItemProps
+  , Thumbnail
+  , buildGalleryTree
+  , galleryCleanupResourceDir
+  , properties
+  , thumbnail)
 import Files
   ( FileName
   , FSNode(..)
@@ -43,8 +51,8 @@ import Files
   , nodeName
   , filterDir
   , ensureParentDir )
-import ItemProcessors (itemFileProcessor, thumbnailFileProcessor)
-import Caching (skipCache, withCache)
+import ItemProcessors (ItemProcessor, itemFileProcessor, thumbnailFileProcessor)
+import Caching (Cache, noCache, buildItemCache, useCached)
 
 
 defaultGalleryConf :: String
@@ -72,6 +80,15 @@ writeJSON outputPath object =
     putStrLn $ "Generating:\t" ++ outputPath
     ensureParentDir JSON.encodeFile outputPath object
 
+loadGalleryIndex :: FilePath -> IO (Maybe GalleryIndex)
+loadGalleryIndex path =
+  doesFileExist path >>= bool (return Nothing) decodeIndex
+  where
+    decodeIndex =
+      JSON.eitherDecodeFileStrict path
+      >>= either (\err -> warn err >> return Nothing) (return . Just)
+    warn = putStrLn . ("Warning:\tUnable to reuse existing index as cache: " ++)
+
 
 (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 (&&&) = liftM2 (&&)
@@ -126,14 +143,17 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     inputTree <- readInputTree sourceTree
     let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
 
-    let cache = if rebuildAll then skipCache else withCache
-    let itemProc = itemProcessor config cache
-    let thumbnailProc = thumbnailProcessor config cache
+    let galleryIndexPath = outputGalleryIndex outputIndexPath
+    cachedIndex <- loadCachedIndex galleryIndexPath
+    let cache = mkCache cachedIndex
+
+    let itemProc = itemProcessor config (cache Resource.properties)
+    let thumbnailProc = thumbnailProcessor config (cache Resource.thumbnail)
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder curatedInputTree
 
     when cleanOutput $ galleryCleanupResourceDir resources outputDirPath
-    writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources
+    writeJSON galleryIndexPath $ GalleryIndex (viewerConfig config) resources
 
   where
     inputGalleryConf :: FilePath -> FilePath
@@ -144,10 +164,25 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     outputGalleryIndex "" = outputDirPath </> defaultIndexFile
     outputGalleryIndex file = file
 
+    loadCachedIndex :: FilePath -> IO (Maybe GalleryIndex)
+    loadCachedIndex galleryIndexPath =
+      if rebuildAll
+        then return Nothing
+        else loadGalleryIndex galleryIndexPath
+
+    mkCache :: Maybe GalleryIndex -> (GalleryItem -> a) -> Cache a
+    mkCache refGalleryIndex =
+      if rebuildAll
+        then const noCache
+        else useCached (buildItemCache $ fmap tree refGalleryIndex)
+
+    itemProcessor :: GalleryConfig -> Cache GalleryItemProps -> ItemProcessor GalleryItemProps
     itemProcessor config cache =
       itemFileProcessor
         (pictureMaxResolution config) cache
         inputDirPath outputDirPath itemsDir
+
+    thumbnailProcessor :: GalleryConfig -> Cache (Maybe Thumbnail) -> ItemProcessor (Maybe Thumbnail)
     thumbnailProcessor config cache =
       thumbnailFileProcessor
         (thumbnailMaxResolution config) cache
-- 
cgit v1.2.3