aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Compiler.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r--compiler/src/Compiler.hs130
1 files changed, 77 insertions, 53 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