diff options
author | pacien | 2020-06-15 04:46:11 +0200 |
---|---|---|
committer | pacien | 2020-06-16 18:34:32 +0200 |
commit | 52abb806a3bde6eb69d64564d971efae2cbfda24 (patch) | |
tree | 3649f42ab8bccc348a68e67fbec97f6b4868ef5d /compiler/src/Caching.hs | |
parent | 8905383e2d17e2adb4097e1ce2e7f90ab9ceb5f5 (diff) | |
download | ldgallery-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.hs | 52 |
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 | ||
19 | module Caching | 19 | module 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 | ||
26 | import Control.Monad (when) | 28 | import Control.Monad (when) |
29 | import qualified Data.Map.Strict as Map | ||
27 | import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist) | 30 | import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist) |
28 | 31 | ||
29 | import FileProcessors (FileProcessor) | 32 | import FileProcessors (FileProcessor) |
33 | import Resource (GalleryItem(..), flattenGalleryTree) | ||
30 | import Files | 34 | import Files |
31 | 35 | ||
32 | 36 | ||
33 | type Cache = FileProcessor -> FileProcessor | 37 | type Cache a = FileProcessor a -> FileProcessor a |
34 | 38 | ||
35 | skipCache :: Cache | ||
36 | skipCache processor inputPath outputPath = | ||
37 | removePathForcibly outputPath | ||
38 | >> processor inputPath outputPath | ||
39 | 39 | ||
40 | withCache :: Cache | 40 | noCache :: Cache a |
41 | withCache processor inputPath outputPath = | 41 | noCache processor itemPath resPath inputFsPath outputFsPath = |
42 | removePathForcibly outputFsPath | ||
43 | >> processor itemPath resPath inputFsPath outputFsPath | ||
44 | |||
45 | |||
46 | type ItemCache = Path -> Maybe GalleryItem | ||
47 | |||
48 | buildItemCache :: Maybe GalleryItem -> ItemCache | ||
49 | buildItemCache 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 | |||
56 | useCached :: ItemCache -> (GalleryItem -> a) -> Cache a | ||
57 | useCached 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) | ||