diff options
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r-- | compiler/src/Compiler.hs | 51 |
1 files changed, 43 insertions, 8 deletions
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 | |||
24 | 24 | ||
25 | import GHC.Generics (Generic) | 25 | import GHC.Generics (Generic) |
26 | import Control.Monad (liftM2, when) | 26 | import Control.Monad (liftM2, when) |
27 | import Data.Bool (bool) | ||
27 | import Data.Maybe (fromMaybe) | 28 | import Data.Maybe (fromMaybe) |
28 | import System.FilePath ((</>)) | 29 | import System.FilePath ((</>)) |
29 | import qualified System.FilePath.Glob as Glob | 30 | import qualified System.FilePath.Glob as Glob |
30 | import System.Directory (canonicalizePath) | 31 | import System.Directory (canonicalizePath, doesFileExist) |
31 | 32 | ||
32 | import Data.Aeson (ToJSON, FromJSON) | 33 | import Data.Aeson (ToJSON, FromJSON) |
33 | import qualified Data.Aeson as JSON | 34 | import qualified Data.Aeson as JSON |
34 | 35 | ||
35 | import Config | 36 | import Config |
36 | import Input (InputTree, readInputTree, filterInputTree, sidecar, tags) | 37 | import Input (InputTree, readInputTree, filterInputTree, sidecar, tags) |
37 | import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) | 38 | import Resource |
39 | ( GalleryItem | ||
40 | , GalleryItemProps | ||
41 | , Thumbnail | ||
42 | , buildGalleryTree | ||
43 | , galleryCleanupResourceDir | ||
44 | , properties | ||
45 | , thumbnail) | ||
38 | import Files | 46 | import Files |
39 | ( FileName | 47 | ( FileName |
40 | , FSNode(..) | 48 | , FSNode(..) |
@@ -43,8 +51,8 @@ import Files | |||
43 | , nodeName | 51 | , nodeName |
44 | , filterDir | 52 | , filterDir |
45 | , ensureParentDir ) | 53 | , ensureParentDir ) |
46 | import ItemProcessors (itemFileProcessor, thumbnailFileProcessor) | 54 | import ItemProcessors (ItemProcessor, itemFileProcessor, thumbnailFileProcessor) |
47 | import Caching (skipCache, withCache) | 55 | import Caching (Cache, noCache, buildItemCache, useCached) |
48 | 56 | ||
49 | 57 | ||
50 | defaultGalleryConf :: String | 58 | defaultGalleryConf :: String |
@@ -72,6 +80,15 @@ writeJSON outputPath object = | |||
72 | putStrLn $ "Generating:\t" ++ outputPath | 80 | putStrLn $ "Generating:\t" ++ outputPath |
73 | ensureParentDir JSON.encodeFile outputPath object | 81 | ensureParentDir JSON.encodeFile outputPath object |
74 | 82 | ||
83 | loadGalleryIndex :: FilePath -> IO (Maybe GalleryIndex) | ||
84 | loadGalleryIndex path = | ||
85 | doesFileExist path >>= bool (return Nothing) decodeIndex | ||
86 | where | ||
87 | decodeIndex = | ||
88 | JSON.eitherDecodeFileStrict path | ||
89 | >>= either (\err -> warn err >> return Nothing) (return . Just) | ||
90 | warn = putStrLn . ("Warning:\tUnable to reuse existing index as cache: " ++) | ||
91 | |||
75 | 92 | ||
76 | (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool | 93 | (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool |
77 | (&&&) = liftM2 (&&) | 94 | (&&&) = liftM2 (&&) |
@@ -126,14 +143,17 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir | |||
126 | inputTree <- readInputTree sourceTree | 143 | inputTree <- readInputTree sourceTree |
127 | let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree | 144 | let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree |
128 | 145 | ||
129 | let cache = if rebuildAll then skipCache else withCache | 146 | let galleryIndexPath = outputGalleryIndex outputIndexPath |
130 | let itemProc = itemProcessor config cache | 147 | cachedIndex <- loadCachedIndex galleryIndexPath |
131 | let thumbnailProc = thumbnailProcessor config cache | 148 | let cache = mkCache cachedIndex |
149 | |||
150 | let itemProc = itemProcessor config (cache Resource.properties) | ||
151 | let thumbnailProc = thumbnailProcessor config (cache Resource.thumbnail) | ||
132 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) | 152 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) |
133 | resources <- galleryBuilder curatedInputTree | 153 | resources <- galleryBuilder curatedInputTree |
134 | 154 | ||
135 | when cleanOutput $ galleryCleanupResourceDir resources outputDirPath | 155 | when cleanOutput $ galleryCleanupResourceDir resources outputDirPath |
136 | writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources | 156 | writeJSON galleryIndexPath $ GalleryIndex (viewerConfig config) resources |
137 | 157 | ||
138 | where | 158 | where |
139 | inputGalleryConf :: FilePath -> FilePath | 159 | inputGalleryConf :: FilePath -> FilePath |
@@ -144,10 +164,25 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir | |||
144 | outputGalleryIndex "" = outputDirPath </> defaultIndexFile | 164 | outputGalleryIndex "" = outputDirPath </> defaultIndexFile |
145 | outputGalleryIndex file = file | 165 | outputGalleryIndex file = file |
146 | 166 | ||
167 | loadCachedIndex :: FilePath -> IO (Maybe GalleryIndex) | ||
168 | loadCachedIndex galleryIndexPath = | ||
169 | if rebuildAll | ||
170 | then return Nothing | ||
171 | else loadGalleryIndex galleryIndexPath | ||
172 | |||
173 | mkCache :: Maybe GalleryIndex -> (GalleryItem -> a) -> Cache a | ||
174 | mkCache refGalleryIndex = | ||
175 | if rebuildAll | ||
176 | then const noCache | ||
177 | else useCached (buildItemCache $ fmap tree refGalleryIndex) | ||
178 | |||
179 | itemProcessor :: GalleryConfig -> Cache GalleryItemProps -> ItemProcessor GalleryItemProps | ||
147 | itemProcessor config cache = | 180 | itemProcessor config cache = |
148 | itemFileProcessor | 181 | itemFileProcessor |
149 | (pictureMaxResolution config) cache | 182 | (pictureMaxResolution config) cache |
150 | inputDirPath outputDirPath itemsDir | 183 | inputDirPath outputDirPath itemsDir |
184 | |||
185 | thumbnailProcessor :: GalleryConfig -> Cache (Maybe Thumbnail) -> ItemProcessor (Maybe Thumbnail) | ||
151 | thumbnailProcessor config cache = | 186 | thumbnailProcessor config cache = |
152 | thumbnailFileProcessor | 187 | thumbnailFileProcessor |
153 | (thumbnailMaxResolution config) cache | 188 | (thumbnailMaxResolution config) cache |