aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/package.yaml1
-rw-r--r--compiler/src/Compiler.hs35
-rw-r--r--compiler/src/Config.hs19
-rw-r--r--compiler/src/Files.hs17
-rw-r--r--compiler/src/Processors.hs12
5 files changed, 62 insertions, 22 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml
index e3c1eb6..b594ee7 100644
--- a/compiler/package.yaml
+++ b/compiler/package.yaml
@@ -19,6 +19,7 @@ dependencies:
19- containers 19- containers
20- filepath 20- filepath
21- directory 21- directory
22- text
22- aeson 23- aeson
23- yaml 24- yaml
24- optparse-applicative 25- optparse-applicative
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)
35import qualified Data.Aeson as JSON 35import qualified Data.Aeson as JSON
36 36
37import Config 37import Config
38import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) 38import Files
39 ( FileName
40 , readDirectory
41 , localPath
42 , isHidden
43 , nodeName
44 , filterDir
45 , flattenDir
46 , root
47 , (/>)
48 , ensureParentDir
49 , isOutdated )
50
39import Input (decodeYamlFile, readInputTree) 51import Input (decodeYamlFile, readInputTree)
40import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) 52import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
41import Gallery (buildGalleryTree) 53import Gallery (buildGalleryTree)
@@ -52,7 +64,10 @@ writeJSON outputPath object =
52compileGallery :: FilePath -> FilePath -> IO () 64compileGallery :: FilePath -> FilePath -> IO ()
53compileGallery inputDirPath outputDirPath = 65compileGallery 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
25module Config 26module Config
@@ -29,25 +30,31 @@ module Config
29 ) where 30 ) where
30 31
31 32
33import Data.Text (Text)
32import GHC.Generics (Generic) 34import GHC.Generics (Generic)
33import Data.Aeson (ToJSON, FromJSON) 35import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=))
34import qualified Data.Aeson as JSON 36import qualified Data.Aeson as JSON
35 37
36import Files (FileName) 38import Files (FileName)
37import Input (decodeYamlFile) 39import Input (decodeYamlFile)
40import Processors (Resolution(..))
38 41
39 42
40data CompilerConfig = CompilerConfig 43data CompilerConfig = CompilerConfig
41 { dummy :: Maybe String -- TODO 44 { thumbnailResolution :: Resolution
42 } deriving (Generic, FromJSON, Show) 45 , pictureMaxResolution :: Maybe Resolution
46 } deriving (Generic, Show)
47
48instance FromJSON CompilerConfig where
49 parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig
50 <$> v .:? "thumbnailResolution" .!= (Resolution 400 400)
51 <*> v .:? "pictureMaxResolution"
52
43 53
44data GalleryConfig = GalleryConfig 54data 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
52readConfig :: FileName -> IO GalleryConfig 59readConfig :: FileName -> IO GalleryConfig
53readConfig = decodeYamlFile 60readConfig = 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)
36import Data.Function ((&)) 36import Data.Function ((&))
37import System.Directory 37import 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
134isOutdated :: FilePath -> FilePath -> IO Bool
135isOutdated 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)
36import Data.Function ((&)) 36import Data.Function ((&))
37import Data.Ratio ((%)) 37import Data.Ratio ((%))
38 38
39import GHC.Generics (Generic)
40import Data.Aeson (FromJSON)
41
39import System.Directory hiding (copyFile) 42import System.Directory hiding (copyFile)
40import qualified System.Directory 43import qualified System.Directory
41import System.FilePath 44import System.FilePath
@@ -64,7 +67,7 @@ formatFromExt _ = Other
64 67
65data Resolution = Resolution 68data Resolution = Resolution
66 { width :: Int 69 { width :: Int
67 , height :: Int } deriving Show 70 , height :: Int } deriving (Show, Generic, FromJSON)
68 71
69type FileProcessor = 72type 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
155type DirFileProcessor = 151type DirFileProcessor =
156 FileName -- ^ Input base path 152 FileName -- ^ Input base path