diff options
-rw-r--r-- | compiler/src/Compiler.hs | 2 | ||||
-rw-r--r-- | compiler/src/Config.hs | 2 | ||||
-rw-r--r-- | compiler/src/Files.hs | 7 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 22 | ||||
-rw-r--r-- | example/gallery.yaml | 2 |
5 files changed, 24 insertions, 11 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index f15192f..9572d50 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -74,7 +74,7 @@ compileGallery inputDirPath outputDirPath rebuildAll = | |||
74 | 74 | ||
75 | let itemProc = itemProcessor (pictureMaxResolution config) cache | 75 | let itemProc = itemProcessor (pictureMaxResolution config) cache |
76 | let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache | 76 | let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache |
77 | let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc | 77 | let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc (implicitDirectoryTag config) |
78 | resources <- galleryBuilder (galleryName config) inputTree | 78 | resources <- galleryBuilder (galleryName config) inputTree |
79 | 79 | ||
80 | galleryCleanupResourceDir resources outputDirPath | 80 | galleryCleanupResourceDir resources outputDirPath |
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index c75ab01..d025afd 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs | |||
@@ -42,6 +42,7 @@ import Resource (Resolution(..)) | |||
42 | 42 | ||
43 | data CompilerConfig = CompilerConfig | 43 | data CompilerConfig = CompilerConfig |
44 | { galleryName :: String | 44 | { galleryName :: String |
45 | , implicitDirectoryTag :: Bool | ||
45 | , thumbnailResolution :: Resolution | 46 | , thumbnailResolution :: Resolution |
46 | , pictureMaxResolution :: Maybe Resolution | 47 | , pictureMaxResolution :: Maybe Resolution |
47 | } deriving (Generic, Show) | 48 | } deriving (Generic, Show) |
@@ -49,6 +50,7 @@ data CompilerConfig = CompilerConfig | |||
49 | instance FromJSON CompilerConfig where | 50 | instance FromJSON CompilerConfig where |
50 | parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig | 51 | parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig |
51 | <$> v .:? "galleryName" .!= "Gallery" | 52 | <$> v .:? "galleryName" .!= "Gallery" |
53 | <*> v .:? "implicitDirectoryTag" .!= False | ||
52 | <*> v .:? "thumbnailResolution" .!= (Resolution 400 400) | 54 | <*> v .:? "thumbnailResolution" .!= (Resolution 400 400) |
53 | <*> v .:? "pictureMaxResolution" | 55 | <*> v .:? "pictureMaxResolution" |
54 | 56 | ||
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index ed082ba..a6649c8 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -23,7 +23,8 @@ | |||
23 | 23 | ||
24 | module Files | 24 | module Files |
25 | ( FileName, LocalPath, WebPath, Path | 25 | ( FileName, LocalPath, WebPath, Path |
26 | , (</>), (</), (/>), (<.>), fileName, subPaths, pathLength | 26 | , (</>), (</), (/>), (<.>) |
27 | , fileName, maybeFileName, subPaths, pathLength | ||
27 | , localPath, webPath | 28 | , localPath, webPath |
28 | , FSNode(..), AnchoredFSNode(..) | 29 | , FSNode(..), AnchoredFSNode(..) |
29 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 30 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
@@ -80,6 +81,10 @@ file /> (Path path) = Path (path ++ [file]) | |||
80 | fileName :: Path -> FileName | 81 | fileName :: Path -> FileName |
81 | fileName (Path (name:_)) = name | 82 | fileName (Path (name:_)) = name |
82 | 83 | ||
84 | maybeFileName :: Path -> Maybe FileName | ||
85 | maybeFileName (Path (name:_)) = Just name | ||
86 | maybeFileName _ = Nothing | ||
87 | |||
83 | subPaths :: Path -> [Path] | 88 | subPaths :: Path -> [Path] |
84 | subPaths (Path path) = map Path $ subsequences path | 89 | subPaths (Path path) = map Path $ subsequences path |
85 | 90 | ||
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index bffa569..bbabf18 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs | |||
@@ -105,15 +105,15 @@ type ThumbnailProcessor = Path -> IO (Maybe Path) | |||
105 | 105 | ||
106 | buildGalleryTree :: | 106 | buildGalleryTree :: |
107 | DirProcessor -> ItemProcessor -> ThumbnailProcessor | 107 | DirProcessor -> ItemProcessor -> ThumbnailProcessor |
108 | -> String -> InputTree -> IO GalleryItem | 108 | -> Bool -> String -> InputTree -> IO GalleryItem |
109 | buildGalleryTree processDir processItem processThumbnail galleryName inputTree = | 109 | buildGalleryTree processDir processItem processThumbnail addDirTag galleryName inputTree = |
110 | mkGalleryItem inputTree >>= return . named galleryName | 110 | mkGalleryItem Nothing inputTree >>= return . named galleryName |
111 | where | 111 | where |
112 | named :: String -> GalleryItem -> GalleryItem | 112 | named :: String -> GalleryItem -> GalleryItem |
113 | named name item = item { title = name } | 113 | named name item = item { title = name } |
114 | 114 | ||
115 | mkGalleryItem :: InputTree -> IO GalleryItem | 115 | mkGalleryItem :: Maybe String -> InputTree -> IO GalleryItem |
116 | mkGalleryItem InputFile{path, sidecar} = | 116 | mkGalleryItem parent InputFile{path, sidecar} = |
117 | do | 117 | do |
118 | (processedItemPath, properties) <- processItem path | 118 | (processedItemPath, properties) <- processItem path |
119 | processedThumbnail <- processThumbnail path | 119 | processedThumbnail <- processThumbnail path |
@@ -121,7 +121,7 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree = | |||
121 | { title = optMeta title $ fileName path | 121 | { title = optMeta title $ fileName path |
122 | , date = optMeta date "" -- TODO: check and normalise dates | 122 | , date = optMeta date "" -- TODO: check and normalise dates |
123 | , description = optMeta description "" | 123 | , description = optMeta description "" |
124 | , tags = optMeta tags [] | 124 | , tags = (optMeta tags []) ++ implicitParentTag parent |
125 | , path = processedItemPath | 125 | , path = processedItemPath |
126 | , thumbnail = processedThumbnail | 126 | , thumbnail = processedThumbnail |
127 | , properties = properties } -- TODO | 127 | , properties = properties } -- TODO |
@@ -129,18 +129,18 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree = | |||
129 | optMeta :: (Sidecar -> Maybe a) -> a -> a | 129 | optMeta :: (Sidecar -> Maybe a) -> a -> a |
130 | optMeta get fallback = fromMaybe fallback $ get sidecar | 130 | optMeta get fallback = fromMaybe fallback $ get sidecar |
131 | 131 | ||
132 | mkGalleryItem InputDir{path, dirThumbnailPath, items} = | 132 | mkGalleryItem parent InputDir{path, dirThumbnailPath, items} = |
133 | do | 133 | do |
134 | processedDir <- processDir path | 134 | processedDir <- processDir path |
135 | processedThumbnail <- maybeThumbnail dirThumbnailPath | 135 | processedThumbnail <- maybeThumbnail dirThumbnailPath |
136 | processedItems <- parallel $ map mkGalleryItem items | 136 | processedItems <- parallel $ map (mkGalleryItem $ maybeFileName path) items |
137 | return GalleryItem | 137 | return GalleryItem |
138 | { title = fileName path | 138 | { title = fileName path |
139 | -- TODO: consider using the most recent item's date? what if empty? | 139 | -- TODO: consider using the most recent item's date? what if empty? |
140 | , date = "" | 140 | , date = "" |
141 | -- TODO: consider allowing metadata sidecars for directories too | 141 | -- TODO: consider allowing metadata sidecars for directories too |
142 | , description = "" | 142 | , description = "" |
143 | , tags = aggregateChildTags processedItems | 143 | , tags = (aggregateChildTags processedItems) ++ implicitParentTag parent |
144 | , path = processedDir | 144 | , path = processedDir |
145 | , thumbnail = processedThumbnail | 145 | , thumbnail = processedThumbnail |
146 | , properties = Directory processedItems } | 146 | , properties = Directory processedItems } |
@@ -155,6 +155,10 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree = | |||
155 | unique :: Ord a => [a] -> [a] | 155 | unique :: Ord a => [a] -> [a] |
156 | unique = Set.toList . Set.fromList | 156 | unique = Set.toList . Set.fromList |
157 | 157 | ||
158 | implicitParentTag :: Maybe String -> [Tag] | ||
159 | implicitParentTag Nothing = [] | ||
160 | implicitParentTag (Just parent) = if addDirTag then [parent] else [] | ||
161 | |||
158 | 162 | ||
159 | flattenGalleryTree :: GalleryItem -> [GalleryItem] | 163 | flattenGalleryTree :: GalleryItem -> [GalleryItem] |
160 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = | 164 | flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = |
diff --git a/example/gallery.yaml b/example/gallery.yaml index 85b1edd..3fd2265 100644 --- a/example/gallery.yaml +++ b/example/gallery.yaml | |||
@@ -1,6 +1,8 @@ | |||
1 | compiler: | 1 | compiler: |
2 | galleryName: Example gallery | 2 | galleryName: Example gallery |
3 | 3 | ||
4 | #implicitDirectoryTag: false # default | ||
5 | |||
4 | #thumbnailResolution: | 6 | #thumbnailResolution: |
5 | # width: 400 # default | 7 | # width: 400 # default |
6 | # height: 400 # default | 8 | # height: 400 # default |