aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
authorpacien2020-05-02 04:11:24 +0200
committerpacien2020-05-02 04:11:24 +0200
commit8e3ac8fe44bebb38e1882ca7f06b8100078ad88d (patch)
treea748fa1e639cb3b5e1f24a8150e89dbb28c980cb /compiler/src
parent7042ffc06326fa8ffe70f5a59747709250166c16 (diff)
parent0e0b5b0ae44da7c1d67983dedd8f8d8d3516236f (diff)
downloadldgallery-1.0.tar.gz
Merge branch 'develop': release v1.0v1.0
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Compiler.hs130
-rw-r--r--compiler/src/Config.hs76
-rw-r--r--compiler/src/Files.hs55
-rw-r--r--compiler/src/Input.hs25
-rw-r--r--compiler/src/Processors.hs144
-rw-r--r--compiler/src/Resource.hs151
6 files changed, 353 insertions, 228 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index a347433..749872d 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -18,20 +18,23 @@
18 18
19module Compiler 19module Compiler
20 ( compileGallery 20 ( compileGallery
21 , writeJSON
21 ) where 22 ) where
22 23
23 24
24import Control.Monad (liftM2) 25import GHC.Generics (Generic)
25import Data.List (any) 26import Control.Monad (liftM2, when)
27import Data.Maybe (fromMaybe)
26import System.FilePath ((</>)) 28import System.FilePath ((</>))
27import qualified System.FilePath.Glob as Glob 29import qualified System.FilePath.Glob as Glob
30import System.Directory (canonicalizePath)
28 31
29import Data.Aeson (ToJSON) 32import Data.Aeson (ToJSON)
30import qualified Data.Aeson as JSON 33import qualified Data.Aeson as JSON
31 34
32import Config 35import Config
33import Input (readInputTree) 36import Input (InputTree, readInputTree, filterInputTree, sidecar, tags)
34import Resource (buildGalleryTree, galleryCleanupResourceDir) 37import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
35import Files 38import Files
36 ( FileName 39 ( FileName
37 , FSNode(..) 40 , FSNode(..)
@@ -45,17 +48,11 @@ import Processors
45 , skipCached, withCached ) 48 , skipCached, withCached )
46 49
47 50
48galleryConf :: String 51defaultGalleryConf :: String
49galleryConf = "gallery.yaml" 52defaultGalleryConf = "gallery.yaml"
50 53
51indexFile :: String 54defaultIndexFile :: String
52indexFile = "index.json" 55defaultIndexFile = "index.json"
53
54viewerMainFile :: String
55viewerMainFile = "index.html"
56
57viewerConfFile :: String
58viewerConfFile = "viewer.json"
59 56
60itemsDir :: String 57itemsDir :: String
61itemsDir = "items" 58itemsDir = "items"
@@ -64,6 +61,12 @@ thumbnailsDir :: String
64thumbnailsDir = "thumbnails" 61thumbnailsDir = "thumbnails"
65 62
66 63
64data GalleryIndex = GalleryIndex
65 { properties :: ViewerConfig
66 , tree :: GalleryItem
67 } deriving (Generic, Show, ToJSON)
68
69
67writeJSON :: ToJSON a => FileName -> a -> IO () 70writeJSON :: ToJSON a => FileName -> a -> IO ()
68writeJSON outputPath object = 71writeJSON outputPath object =
69 do 72 do
@@ -71,61 +74,82 @@ writeJSON outputPath object =
71 ensureParentDir JSON.encodeFile outputPath object 74 ensureParentDir JSON.encodeFile outputPath object
72 75
73 76
74galleryDirFilter :: ([Glob.Pattern], [Glob.Pattern]) -> FSNode -> Bool 77(&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
75galleryDirFilter (inclusionPatterns, exclusionPatterns) = 78(&&&) = liftM2 (&&)
79
80(|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
81(|||) = liftM2 (||)
82
83anyPattern :: [String] -> String -> Bool
84anyPattern patterns string = any (flip Glob.match string) (map Glob.compile patterns)
85
86galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool
87galleryDirFilter config excludedCanonicalDirs =
76 (not . isHidden) 88 (not . isHidden)
77 &&& (matchName True $ anyPattern inclusionPatterns) 89 &&& (not . isExcludedDir)
78 &&& (not . isConfigFile) 90 &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
79 &&& (not . containsOutputGallery) 91 (matchesFile $ anyPattern $ includedFiles config))
80 &&& (not . (matchName False $ anyPattern exclusionPatterns)) 92 &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
93 (matchesFile $ anyPattern $ excludedFiles config)))
81 94
82 where 95 where
83 (&&&) = liftM2 (&&) 96 matchesDir :: (FileName -> Bool) -> FSNode -> Bool
84 (|||) = liftM2 (||) 97 matchesDir cond dir@Dir{} = maybe False cond $ nodeName dir
98 matchesDir _ File{} = False
85 99
86 matchName :: Bool -> (FileName -> Bool) -> FSNode -> Bool 100 matchesFile :: (FileName -> Bool) -> FSNode -> Bool
87 matchName matchDir _ Dir{} = matchDir 101 matchesFile cond file@File{} = maybe False cond $ nodeName file
88 matchName _ cond file@File{} = maybe False cond $ nodeName file 102 matchesFile _ Dir{} = False
89 103
90 anyPattern :: [Glob.Pattern] -> FileName -> Bool 104 isExcludedDir :: FSNode -> Bool
91 anyPattern patterns filename = any (flip Glob.match filename) patterns 105 isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs
106 isExcludedDir File{} = False
92 107
93 isConfigFile = matchName False (== galleryConf) 108inputTreeFilter :: GalleryConfig -> InputTree -> Bool
94 isGalleryIndex = matchName False (== indexFile) 109inputTreeFilter GalleryConfig{includedTags, excludedTags} =
95 isViewerIndex = matchName False (== viewerMainFile) 110 (hasTagMatching $ anyPattern includedTags)
96 containsOutputGallery File{} = False 111 &&& (not . (hasTagMatching $ anyPattern excludedTags))
97 containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items 112
113 where
114 hasTagMatching :: (String -> Bool) -> InputTree -> Bool
115 hasTagMatching cond = (any cond) . (fromMaybe [""] . tags) . sidecar
98 116
99 117
100compileGallery :: FilePath -> FilePath -> Bool -> IO () 118compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO ()
101compileGallery inputDirPath outputDirPath rebuildAll = 119compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDirs rebuildAll cleanOutput =
102 do 120 do
103 fullConfig <- readConfig inputGalleryConf 121 config <- readConfig $ inputGalleryConf configPath
104 let config = compiler fullConfig
105 122
106 inputDir <- readDirectory inputDirPath 123 inputDir <- readDirectory inputDirPath
107 let inclusionPatterns = map Glob.compile $ includeFiles config 124 excludedCanonicalDirs <- mapM canonicalizePath excludedDirs
108 let exclusionPatterns = map Glob.compile $ excludeFiles config 125 let sourceFilter = galleryDirFilter config excludedCanonicalDirs
109 let sourceFilter = galleryDirFilter (inclusionPatterns, exclusionPatterns)
110 let sourceTree = filterDir sourceFilter inputDir 126 let sourceTree = filterDir sourceFilter inputDir
111 inputTree <- readInputTree sourceTree 127 inputTree <- readInputTree sourceTree
128 let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
112 129
113 let cache = if rebuildAll then skipCached else withCached 130 let cache = if rebuildAll then skipCached else withCached
114 let itemProc = itemProcessor (pictureMaxResolution config) cache 131 let itemProc = itemProcessor config cache
115 let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache 132 let thumbnailProc = thumbnailProcessor config cache
116 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) 133 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
117 resources <- galleryBuilder (galleryName config) inputTree 134 resources <- galleryBuilder curatedInputTree
118 135
119 galleryCleanupResourceDir resources outputDirPath 136 when cleanOutput $ galleryCleanupResourceDir resources outputDirPath
120 writeJSON outputIndex resources 137 writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources
121 writeJSON outputViewerConf $ viewer fullConfig
122 138
123 where 139 where
124 inputGalleryConf = inputDirPath </> galleryConf 140 inputGalleryConf :: FilePath -> FilePath
125 outputIndex = outputDirPath </> indexFile 141 inputGalleryConf "" = inputDirPath </> defaultGalleryConf
126 outputViewerConf = outputDirPath </> viewerConfFile 142 inputGalleryConf file = file
127 143
128 itemProcessor maxRes cache = 144 outputGalleryIndex :: FilePath -> FilePath
129 itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir 145 outputGalleryIndex "" = outputDirPath </> defaultIndexFile
130 thumbnailProcessor thumbRes cache = 146 outputGalleryIndex file = file
131 thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir 147
148 itemProcessor config cache =
149 itemFileProcessor
150 (pictureMaxResolution config) cache
151 inputDirPath outputDirPath itemsDir
152 thumbnailProcessor config cache =
153 thumbnailFileProcessor
154 (thumbnailMaxResolution config) cache
155 inputDirPath outputDirPath thumbnailsDir
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 53333a5..0ae0fa1 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -17,44 +17,74 @@
17-- along with this program. If not, see <https://www.gnu.org/licenses/>. 17-- along with this program. If not, see <https://www.gnu.org/licenses/>.
18 18
19module Config 19module Config
20 ( GalleryConfig(..) 20 ( GalleryConfig(..), readConfig
21 , CompilerConfig(..) 21 , ViewerConfig(..), viewerConfig
22 , readConfig 22 , TagsFromDirectoriesConfig(..)
23 , Resolution(..)
23 ) where 24 ) where
24 25
25 26
26import GHC.Generics (Generic) 27import GHC.Generics (Generic)
27import Data.Aeson (FromJSON, withObject, (.:?), (.!=)) 28import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=))
28import qualified Data.Aeson as JSON 29import qualified Data.Aeson as JSON
29 30
30import Files (FileName) 31import Files (FileName)
31import Input (decodeYamlFile) 32import Input (decodeYamlFile)
32import Resource (Resolution(..))
33 33
34 34
35data CompilerConfig = CompilerConfig 35data Resolution = Resolution
36 { galleryName :: String 36 { width :: Int
37 , includeFiles :: [String] 37 , height :: Int
38 , excludeFiles :: [String] 38 } deriving (Generic, Show, ToJSON, FromJSON)