aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Compiler.hs
diff options
context:
space:
mode:
authorNotkea2020-01-10 22:31:47 +0100
committerGitHub2020-01-10 22:31:47 +0100
commit7042ffc06326fa8ffe70f5a59747709250166c16 (patch)
treedbfc7567bd106e03a47b499d2a07cecb6b8d6305 /compiler/src/Compiler.hs
parentc9264b0a0a7e1cb92ef7d9a391cee2c94376cff3 (diff)
parent27b51018525dbb7a6edb3073819d82245387ddd3 (diff)
downloadldgallery-7042ffc06326fa8ffe70f5a59747709250166c16.tar.gz
Merge pull request #34 from pacien/develop
first working prototype
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r--compiler/src/Compiler.hs131
1 files changed, 131 insertions, 0 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
new file mode 100644
index 0000000..a347433
--- /dev/null
+++ b/compiler/src/Compiler.hs
@@ -0,0 +1,131 @@
1-- ldgallery - A static generator which turns a collection of tagged
2-- pictures into a searchable web gallery.
3--
4-- Copyright (C) 2019-2020 Pacien TRAN-GIRARD
5--
6-- This program is free software: you can redistribute it and/or modify
7-- it under the terms of the GNU Affero General Public License as
8-- published by the Free Software Foundation, either version 3 of the
9-- License, or (at your option) any later version.
10--
11-- This program is distributed in the hope that it will be useful,
12-- but WITHOUT ANY WARRANTY; without even the implied warranty of
13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14-- GNU Affero General Public License for more details.
15--
16-- You should have received a copy of the GNU Affero General Public License
17-- along with this program. If not, see <https://www.gnu.org/licenses/>.
18
19module Compiler
20 ( compileGallery
21 ) where
22
23
24import Control.Monad (liftM2)
25import Data.List (any)
26import System.FilePath ((</>))
27import qualified System.FilePath.Glob as Glob
28
29import Data.Aeson (ToJSON)
30import qualified Data.Aeson as JSON
31
32import Config
33import Input (readInputTree)
34import Resource (buildGalleryTree, galleryCleanupResourceDir)
35import Files
36 ( FileName
37 , FSNode(..)
38 , readDirectory
39 , isHidden
40 , nodeName
41 , filterDir
42 , ensureParentDir )
43import Processors
44 ( itemFileProcessor, thumbnailFileProcessor
45 , skipCached, withCached )
46
47
48galleryConf :: String
49galleryConf = "gallery.yaml"
50
51indexFile :: String
52indexFile = "index.json"
53
54viewerMainFile :: String
55viewerMainFile = "index.html"
56
57viewerConfFile :: String
58viewerConfFile = "viewer.json"
59
60itemsDir :: String
61itemsDir = "items"
62
63thumbnailsDir :: String
64thumbnailsDir = "thumbnails"
65
66
67writeJSON :: ToJSON a => FileName -> a -> IO ()
68writeJSON outputPath object =
69 do
70 putStrLn $ "Generating:\t" ++ outputPath
71 ensureParentDir JSON.encodeFile outputPath object
72
73
74galleryDirFilter :: ([Glob.Pattern], [Glob.Pattern]) -> FSNode -> Bool
75galleryDirFilter (inclusionPatterns, exclusionPatterns) =
76 (not . isHidden)
77 &&& (matchName True $ anyPattern inclusionPatterns)
78 &&& (not . isConfigFile)
79 &&& (not . containsOutputGallery)
80 &&& (not . (matchName False $ anyPattern exclusionPatterns))
81
82 where
83 (&&&) = liftM2 (&&)
84 (|||) = liftM2 (||)
85
86 matchName :: Bool -> (FileName -> Bool) -> FSNode -> Bool
87 matchName matchDir _ Dir{} = matchDir
88 matchName _ cond file@File{} = maybe False cond $ nodeName file
89
90 anyPattern :: [Glob.Pattern] -> FileName -> Bool
91 anyPattern patterns filename = any (flip Glob.match filename) patterns
92
93 isConfigFile = matchName False (== galleryConf)
94 isGalleryIndex = matchName False (== indexFile)
95 isViewerIndex = matchName False (== viewerMainFile)
96 containsOutputGallery File{} = False
97 containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items
98
99
100compileGallery :: FilePath -> FilePath -> Bool -> IO ()
101compileGallery inputDirPath outputDirPath rebuildAll =
102 do
103 fullConfig <- readConfig inputGalleryConf
104 let config = compiler fullConfig
105
106 inputDir <- readDirectory inputDirPath
107 let inclusionPatterns = map Glob.compile $ includeFiles config
108 let exclusionPatterns = map Glob.compile $ excludeFiles config
109 let sourceFilter = galleryDirFilter (inclusionPatterns, exclusionPatterns)
110 let sourceTree = filterDir sourceFilter inputDir
111 inputTree <- readInputTree sourceTree
112
113 let cache = if rebuildAll then skipCached else withCached
114 let itemProc = itemProcessor (pictureMaxResolution config) cache
115 let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
116 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
117 resources <- galleryBuilder (galleryName config) inputTree
118
119 galleryCleanupResourceDir resources outputDirPath
120 writeJSON outputIndex resources
121 writeJSON outputViewerConf $ viewer fullConfig
122
123 where
124 inputGalleryConf = inputDirPath </> galleryConf
125 outputIndex = outputDirPath </> indexFile
126 outputViewerConf = outputDirPath </> viewerConfFile
127
128 itemProcessor maxRes cache =
129 itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
130 thumbnailProcessor thumbRes cache =
131 thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir