diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 35 | ||||
-rw-r--r-- | compiler/src/Config.hs | 19 | ||||
-rw-r--r-- | compiler/src/Files.hs | 17 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 12 |
4 files changed, 61 insertions, 22 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 5c47521..854fd03 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -35,7 +35,19 @@ import Data.Aeson (ToJSON) | |||
35 | import qualified Data.Aeson as JSON | 35 | import qualified Data.Aeson as JSON |
36 | 36 | ||
37 | import Config | 37 | import Config |
38 | import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) | 38 | import Files |
39 | ( FileName | ||
40 | , readDirectory | ||
41 | , localPath | ||
42 | , isHidden | ||
43 | , nodeName | ||
44 | , filterDir | ||
45 | , flattenDir | ||
46 | , root | ||
47 | , (/>) | ||
48 | , ensureParentDir | ||
49 | , isOutdated ) | ||
50 | |||
39 | import Input (decodeYamlFile, readInputTree) | 51 | import Input (decodeYamlFile, readInputTree) |
40 | import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) | 52 | import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) |
41 | import Gallery (buildGalleryTree) | 53 | import Gallery (buildGalleryTree) |
@@ -52,7 +64,10 @@ writeJSON outputPath object = | |||
52 | compileGallery :: FilePath -> FilePath -> IO () | 64 | compileGallery :: FilePath -> FilePath -> IO () |
53 | compileGallery inputDirPath outputDirPath = | 65 | compileGallery inputDirPath outputDirPath = |
54 | do | 66 | do |
55 | config <- readConfig (inputDirPath </> galleryConf) | 67 | fullConfig <- readConfig inputGalleryConf |
68 | let config = compiler fullConfig | ||
69 | |||
70 | -- TODO: exclude output dir if it's under the input dir | ||
56 | inputDir <- readDirectory inputDirPath | 71 | inputDir <- readDirectory inputDirPath |
57 | 72 | ||
58 | let isGalleryFile = \n -> nodeName n == galleryConf | 73 | let isGalleryFile = \n -> nodeName n == galleryConf |
@@ -60,20 +75,26 @@ compileGallery inputDirPath outputDirPath = | |||
60 | 75 | ||
61 | inputTree <- readInputTree galleryTree | 76 | inputTree <- readInputTree galleryTree |
62 | 77 | ||
78 | invalidateCache <- isOutdated inputGalleryConf outputIndex | ||
79 | let cache = if invalidateCache then skipCached else withCached | ||
63 | let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir | 80 | let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir |
64 | let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir | 81 | let itemProc = itemFileProcessor (pictureMaxResolution config) cache inputDirPath outputDirPath itemsDir |
65 | let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir | 82 | let thumbnailProc = thumbnailFileProcessor (thumbnailResolution config) cache inputDirPath outputDirPath thumbnailsDir |
66 | resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree | 83 | resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree |
67 | 84 | ||
68 | cleanupResourceDir resourceTree outputDirPath | 85 | cleanupResourceDir resourceTree outputDirPath |
69 | 86 | ||
70 | buildGalleryTree resourceTree | 87 | buildGalleryTree resourceTree |
71 | & writeJSON (outputDirPath </> "index.json") | 88 | & writeJSON outputIndex |
72 | 89 | ||
73 | viewer config | 90 | viewer fullConfig |
74 | & writeJSON (outputDirPath </> "viewer.json") | 91 | & writeJSON outputViewerConf |
75 | 92 | ||
76 | where | 93 | where |
77 | galleryConf = "gallery.yaml" | 94 | galleryConf = "gallery.yaml" |
78 | itemsDir = "items" | 95 | itemsDir = "items" |
79 | thumbnailsDir = "thumbnails" | 96 | thumbnailsDir = "thumbnails" |
97 | |||
98 | inputGalleryConf = inputDirPath </> galleryConf | ||
99 | outputIndex = outputDirPath </> "index.json" | ||
100 | outputViewerConf = outputDirPath </> "viewer.json" | ||
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index f147bdd..fe981c3 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs | |||
@@ -20,6 +20,7 @@ | |||
20 | DuplicateRecordFields | 20 | DuplicateRecordFields |
21 | , DeriveGeneric | 21 | , DeriveGeneric |
22 | , DeriveAnyClass | 22 | , DeriveAnyClass |
23 | , OverloadedStrings | ||
23 | #-} | 24 | #-} |
24 | 25 | ||
25 | module Config | 26 | module Config |
@@ -29,25 +30,31 @@ module Config | |||
29 | ) where | 30 | ) where |
30 | 31 | ||
31 | 32 | ||
33 | import Data.Text (Text) | ||
32 | import GHC.Generics (Generic) | 34 | import GHC.Generics (Generic) |
33 | import Data.Aeson (ToJSON, FromJSON) | 35 | import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=)) |
34 | import qualified Data.Aeson as JSON | 36 | import qualified Data.Aeson as JSON |
35 | 37 | ||
36 | import Files (FileName) | 38 | import Files (FileName) |
37 | import Input (decodeYamlFile) | 39 | import Input (decodeYamlFile) |
40 | import Processors (Resolution(..)) | ||
38 | 41 | ||
39 | 42 | ||
40 | data CompilerConfig = CompilerConfig | 43 | data CompilerConfig = CompilerConfig |
41 | { dummy :: Maybe String -- TODO | 44 | { thumbnailResolution :: Resolution |
42 | } deriving (Generic, FromJSON, Show) | 45 | , pictureMaxResolution :: Maybe Resolution |
46 | } deriving (Generic, Show) | ||
47 | |||
48 | instance FromJSON CompilerConfig where | ||
49 | parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig | ||
50 | <$> v .:? "thumbnailResolution" .!= (Resolution 400 400) | ||
51 | <*> v .:? "pictureMaxResolution" | ||
52 | |||
43 | 53 | ||
44 | data GalleryConfig = GalleryConfig | 54 | data GalleryConfig = GalleryConfig |
45 | { compiler :: CompilerConfig | 55 | { compiler :: CompilerConfig |
46 | , viewer :: JSON.Object | 56 | , viewer :: JSON.Object |
47 | } deriving (Generic, FromJSON, Show) | 57 | } deriving (Generic, FromJSON, Show) |
48 | 58 | ||
49 | -- TODO: add compiler config keys and their default values | ||
50 | |||
51 | |||
52 | readConfig :: FileName -> IO GalleryConfig | 59 | readConfig :: FileName -> IO GalleryConfig |
53 | readConfig = decodeYamlFile | 60 | readConfig = decodeYamlFile |
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 23daf3a..fb46c33 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -26,7 +26,7 @@ module Files | |||
26 | , (</>), (</), (/>), localPath, webPath | 26 | , (</>), (</), (/>), localPath, webPath |
27 | , FSNode(..), AnchoredFSNode(..) | 27 | , FSNode(..), AnchoredFSNode(..) |
28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
29 | , ensureParentDir, remove | 29 | , ensureParentDir, remove, isOutdated |
30 | ) where | 30 | ) where |
31 | 31 | ||
32 | 32 | ||
@@ -36,6 +36,8 @@ import Data.List (isPrefixOf, length, deleteBy) | |||
36 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
37 | import System.Directory | 37 | import System.Directory |
38 | ( doesDirectoryExist | 38 | ( doesDirectoryExist |
39 | , doesPathExist | ||
40 | , getModificationTime | ||
39 | , listDirectory | 41 | , listDirectory |
40 | , createDirectoryIfMissing | 42 | , createDirectoryIfMissing |
41 | , removePathForcibly ) | 43 | , removePathForcibly ) |
@@ -128,3 +130,16 @@ remove path = | |||
128 | do | 130 | do |
129 | putStrLn $ "Removing:\t" ++ path | 131 | putStrLn $ "Removing:\t" ++ path |
130 | removePathForcibly path | 132 | removePathForcibly path |
133 | |||
134 | isOutdated :: FilePath -> FilePath -> IO Bool | ||
135 | isOutdated ref target = | ||
136 | do | ||
137 | refExists <- doesPathExist ref | ||
138 | targetExists <- doesPathExist target | ||
139 | if refExists && targetExists then | ||
140 | do | ||
141 | refTime <- getModificationTime ref | ||
142 | targetTime <- getModificationTime target | ||
143 | return (targetTime < refTime) | ||
144 | else | ||
145 | return True | ||
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index aaa178f..c097db7 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -36,6 +36,9 @@ import Control.Exception (throwIO) | |||
36 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
37 | import Data.Ratio ((%)) | 37 | import Data.Ratio ((%)) |
38 | 38 | ||
39 | import GHC.Generics (Generic) | ||
40 | import Data.Aeson (FromJSON) | ||
41 | |||
39 | import System.Directory hiding (copyFile) | 42 | import System.Directory hiding (copyFile) |
40 | import qualified System.Directory | 43 | import qualified System.Directory |
41 | import System.FilePath | 44 | import System.FilePath |
@@ -64,7 +67,7 @@ formatFromExt _ = Other | |||
64 | 67 | ||
65 | data Resolution = Resolution | 68 | data Resolution = Resolution |
66 | { width :: Int | 69 | { width :: Int |
67 | , height :: Int } deriving Show | 70 | , height :: Int } deriving (Show, Generic, FromJSON) |
68 | 71 | ||
69 | type FileProcessor = | 72 | type FileProcessor = |
70 | FileName -- ^ Input path | 73 | FileName -- ^ Input path |
@@ -144,13 +147,6 @@ withCached processor inputPath outputPath = | |||
144 | update = processor inputPath outputPath | 147 | update = processor inputPath outputPath |
145 | skip = putStrLn $ "Skipping:\t" ++ outputPath | 148 | skip = putStrLn $ "Skipping:\t" ++ outputPath |
146 | 149 | ||
147 | isOutdated :: FilePath -> FilePath -> IO Bool | ||
148 | isOutdated ref target = | ||
149 | do | ||
150 | refTime <- getModificationTime ref | ||
151 | targetTime <- getModificationTime target | ||
152 | return (targetTime < refTime) | ||
153 | |||
154 | 150 | ||
155 | type DirFileProcessor = | 151 | type DirFileProcessor = |
156 | FileName -- ^ Input base path | 152 | FileName -- ^ Input base path |