aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Caching.hs
diff options
context:
space:
mode:
authorpacien2020-06-15 04:46:11 +0200
committerpacien2020-06-16 18:34:32 +0200
commit52abb806a3bde6eb69d64564d971efae2cbfda24 (patch)
tree3649f42ab8bccc348a68e67fbec97f6b4868ef5d /compiler/src/Caching.hs
parent8905383e2d17e2adb4097e1ce2e7f90ab9ceb5f5 (diff)
downloadldgallery-52abb806a3bde6eb69d64564d971efae2cbfda24.tar.gz
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
Diffstat (limited to 'compiler/src/Caching.hs')
-rw-r--r--compiler/src/Caching.hs52
1 files changed, 36 insertions, 16 deletions
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 @@
18 18
19module Caching 19module Caching
20 ( Cache 20 ( Cache
21 , skipCache 21 , noCache
22 , withCache 22 , ItemCache
23 , buildItemCache
24 , useCached
23 ) where 25 ) where
24 26
25 27
26import Control.Monad (when) 28import Control.Monad (when)
29import qualified Data.Map.Strict as Map
27import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist) 30import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
28 31
29import FileProcessors (FileProcessor) 32import FileProcessors (FileProcessor)
33import Resource (GalleryItem(..), flattenGalleryTree)
30import Files 34import Files
31 35
32 36
33type Cache = FileProcessor -> FileProcessor 37type Cache a = FileProcessor a -> FileProcessor a
34 38
35skipCache :: Cache
36skipCache processor inputPath outputPath =
37 removePathForcibly outputPath
38 >> processor inputPath outputPath
39 39
40withCache :: Cache 40noCache :: Cache a
41withCache processor inputPath outputPath = 41noCache processor itemPath resPath inputFsPath outputFsPath =
42 removePathForcibly outputFsPath
43 >> processor itemPath resPath inputFsPath outputFsPath
44
45
46type ItemCache = Path -> Maybe GalleryItem
47
48buildItemCache :: Maybe GalleryItem -> ItemCache
49buildItemCache cachedItems = lookupCache
50 where
51 withKey item = (webPath $ Resource.path item, item)
52 cachedItemList = maybe [] flattenGalleryTree cachedItems
53 cachedMap = Map.fromList (map withKey cachedItemList)
54 lookupCache path = Map.lookup (webPath path) cachedMap
55
56useCached :: ItemCache -> (GalleryItem -> a) -> Cache a
57useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
42 do 58 do
43 isDir <- doesDirectoryExist outputPath 59 isDir <- doesDirectoryExist outputFsPath
44 when isDir $ removePathForcibly outputPath 60 when isDir $ removePathForcibly outputFsPath
45 61
46 fileExists <- doesFileExist outputPath 62 fileExists <- doesFileExist outputFsPath
47 if fileExists then 63 if fileExists then
48 do 64 do
49 needUpdate <- isOutdated True inputPath outputPath 65 needUpdate <- isOutdated True inputFsPath outputFsPath
50 if needUpdate then update else skip 66 case (needUpdate, cache itemPath) of
67 (False, Just props) -> fromCache props
68 _ -> update
51 else 69 else
52 update 70 update
53 71
54 where 72 where
55 update = processor inputPath outputPath 73 update = processor itemPath resPath inputFsPath outputFsPath
56 skip = putStrLn $ "Skipping:\t" ++ outputPath 74 fromCache props =
75 putStrLn ("From cache:\t" ++ outputFsPath)
76 >> return (propGetter props)