diff options
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) | ||