aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Caching.hs52
-rw-r--r--compiler/src/Compiler.hs51
-rw-r--r--compiler/src/FileProcessors.hs59
-rw-r--r--compiler/src/Input.hs4
-rw-r--r--compiler/src/ItemProcessors.hs85
-rw-r--r--compiler/src/Resource.hs38
6 files changed, 185 insertions, 104 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)
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
diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs
index 8ea04d1..5c4e1c8 100644
--- a/compiler/src/FileProcessors.hs
+++ b/compiler/src/FileProcessors.hs
@@ -18,12 +18,18 @@
18 18
19module FileProcessors 19module FileProcessors
20 ( FileProcessor 20 ( FileProcessor
21 , transformThenDescribe
22 , copyResource
23 , noopProcessor
24 , FileTransformer
21 , copyFileProcessor 25 , copyFileProcessor
22 , resizePictureUpTo 26 , resizePictureUpTo
23 , resourceAt 27 , resourceAt
24 , getImageResolution 28 , getImageResolution
25 , ItemDescriber 29 , FileDescriber
30 , getResProps
26 , getPictureProps 31 , getPictureProps
32 , getThumbnailProps
27 ) where 33 ) where
28 34
29 35
@@ -35,24 +41,43 @@ import System.Directory (getModificationTime)
35import qualified System.Directory 41import qualified System.Directory
36 42
37import Config (Resolution(..)) 43import Config (Resolution(..))