aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Compiler.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r--compiler/src/Compiler.hs51
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
25import GHC.Generics (Generic) 25import GHC.Generics (Generic)
26import Control.Monad (liftM2, when) 26import Control.Monad (liftM2, when)
27import Data.Bool (bool)
27import Data.Maybe (fromMaybe) 28import Data.Maybe (fromMaybe)
28import System.FilePath ((</>)) 29import System.FilePath ((</>))
29import qualified System.FilePath.Glob as Glob 30import qualified System.FilePath.Glob as Glob
30import System.Directory (canonicalizePath) 31import System.Directory (canonicalizePath, doesFileExist)
31 32
32import Data.Aeson (ToJSON, FromJSON) 33import Data.Aeson (ToJSON, FromJSON)
33import qualified Data.Aeson as JSON 34import qualified Data.Aeson as JSON
34 35
35import Config 36import Config
36import Input (InputTree, readInputTree, filterInputTree, sidecar, tags) 37import Input (InputTree, readInputTree, filterInputTree, sidecar, tags)
37import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) 38import Resource
39 ( GalleryItem
40 , GalleryItemProps
41 , Thumbnail
42 , buildGalleryTree
43 , galleryCleanupResourceDir
44 , properties
45 , thumbnail)
38import Files 46import 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 )
46import ItemProcessors (itemFileProcessor, thumbnailFileProcessor) 54import ItemProcessors (ItemProcessor, itemFileProcessor, thumbnailFileProcessor)
47import Caching (skipCache, withCache) 55import Caching (Cache, noCache, buildItemCache, useCached)
48 56
49 57
50defaultGalleryConf :: String 58defaultGalleryConf :: 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
83loadGalleryIndex :: FilePath -> IO (Maybe GalleryIndex)
84loadGalleryIndex 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