diff options
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r-- | compiler/src/Compiler.hs | 30 |
1 files changed, 22 insertions, 8 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 51f5065..fa405a2 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -25,6 +25,7 @@ module Compiler | |||
25 | import GHC.Generics (Generic) | 25 | import GHC.Generics (Generic) |
26 | import Control.Monad (liftM2, when) | 26 | import Control.Monad (liftM2, when) |
27 | import Data.List (any) | 27 | import Data.List (any) |
28 | import Data.Maybe (fromMaybe) | ||
28 | import System.FilePath ((</>)) | 29 | import System.FilePath ((</>)) |
29 | import qualified System.FilePath.Glob as Glob | 30 | import qualified System.FilePath.Glob as Glob |
30 | import System.Directory (canonicalizePath) | 31 | import System.Directory (canonicalizePath) |
@@ -33,7 +34,7 @@ import Data.Aeson (ToJSON) | |||
33 | import qualified Data.Aeson as JSON | 34 | import qualified Data.Aeson as JSON |
34 | 35 | ||
35 | import Config | 36 | import Config |
36 | import Input (readInputTree) | 37 | import Input (InputTree, readInputTree, filterInputTree, sidecar, tags) |
37 | import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) | 38 | import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) |
38 | import Files | 39 | import Files |
39 | ( FileName | 40 | ( FileName |
@@ -74,6 +75,15 @@ writeJSON outputPath object = | |||
74 | ensureParentDir JSON.encodeFile outputPath object | 75 | ensureParentDir JSON.encodeFile outputPath object |
75 | 76 | ||
76 | 77 | ||
78 | (&&&) :: (a -> Bool) -> (a -> Bool) -> a -> Bool | ||
79 | (&&&) = liftM2 (&&) | ||
80 | |||
81 | (|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool | ||
82 | (|||) = liftM2 (||) | ||
83 | |||
84 | anyPattern :: [String] -> String -> Bool | ||
85 | anyPattern patterns string = any (flip Glob.match string) (map Glob.compile patterns) | ||
86 | |||
77 | galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool | 87 | galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool |
78 | galleryDirFilter config excludedCanonicalDirs = | 88 | galleryDirFilter config excludedCanonicalDirs = |
79 | (not . isHidden) | 89 | (not . isHidden) |
@@ -84,9 +94,6 @@ galleryDirFilter config excludedCanonicalDirs = | |||
84 | (matchesFile $ anyPattern $ excludedFiles config))) | 94 | (matchesFile $ anyPattern $ excludedFiles config))) |
85 | 95 | ||
86 | where | 96 | where |
87 | (&&&) = liftM2 (&&) | ||
88 | (|||) = liftM2 (||) | ||
89 | |||
90 | matchesDir :: (FileName -> Bool) -> FSNode -> Bool | 97 | matchesDir :: (FileName -> Bool) -> FSNode -> Bool |
91 | matchesDir cond dir@Dir{} = maybe False cond $ nodeName dir | 98 | matchesDir cond dir@Dir{} = maybe False cond $ nodeName dir |
92 | matchesDir _ File{} = False | 99 | matchesDir _ File{} = False |
@@ -95,13 +102,19 @@ galleryDirFilter config excludedCanonicalDirs = | |||
95 | matchesFile cond file@File{} = maybe False cond $ nodeName file | 102 | matchesFile cond file@File{} = maybe False cond $ nodeName file |
96 | matchesFile _ Dir{} = False | 103 | matchesFile _ Dir{} = False |
97 | 104 | ||
98 | anyPattern :: [String] -> FileName -> Bool | ||
99 | anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns) | ||
100 | |||
101 | isExcludedDir :: FSNode -> Bool | 105 | isExcludedDir :: FSNode -> Bool |
102 | isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs | 106 | isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs |
103 | isExcludedDir File{} = False | 107 | isExcludedDir File{} = False |
104 | 108 | ||
109 | inputTreeFilter :: GalleryConfig -> InputTree -> Bool | ||
110 | inputTreeFilter GalleryConfig{includedTags, excludedTags} = | ||
111 | (hasTagMatching $ anyPattern includedTags) | ||
112 | &&& (not . (hasTagMatching $ anyPattern excludedTags)) | ||
113 | |||
114 | where | ||
115 | hasTagMatching :: (String -> Bool) -> InputTree -> Bool | ||
116 | hasTagMatching cond = (any cond) . (fromMaybe [""] . tags) . sidecar | ||
117 | |||
105 | 118 | ||
106 | compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO () | 119 | compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO () |
107 | compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDirs rebuildAll cleanOutput = | 120 | compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDirs rebuildAll cleanOutput = |
@@ -113,12 +126,13 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir | |||
113 | let sourceFilter = galleryDirFilter config excludedCanonicalDirs | 126 | let sourceFilter = galleryDirFilter config excludedCanonicalDirs |
114 | let sourceTree = filterDir sourceFilter inputDir | 127 | let sourceTree = filterDir sourceFilter inputDir |
115 | inputTree <- readInputTree sourceTree | 128 | inputTree <- readInputTree sourceTree |
129 | let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree | ||
116 | 130 | ||
117 | let cache = if rebuildAll then skipCached else withCached | 131 | let cache = if rebuildAll then skipCached else withCached |
118 | let itemProc = itemProcessor config cache | 132 | let itemProc = itemProcessor config cache |
119 | let thumbnailProc = thumbnailProcessor config cache | 133 | let thumbnailProc = thumbnailProcessor config cache |
120 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) | 134 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) |
121 | resources <- galleryBuilder inputTree | 135 | resources <- galleryBuilder curatedInputTree |
122 | 136 | ||
123 | when cleanOutput $ galleryCleanupResourceDir resources outputDirPath | 137 | when cleanOutput $ galleryCleanupResourceDir resources outputDirPath |
124 | writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources | 138 | writeJSON (outputGalleryIndex outputIndexPath) $ GalleryIndex (viewerConfig config) resources |