aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpacien2019-12-31 01:39:23 +0100
committerpacien2019-12-31 01:39:23 +0100
commit7ef9f09c0f3be1cd5e1f38c9abc845abc9ed3639 (patch)
treeb727b960c95feae01f52274013c1ad2ccb01c4d5
parent856d6ea290f6050e813e9cd5634b9e9960995671 (diff)
downloadldgallery-7ef9f09c0f3be1cd5e1f38c9abc845abc9ed3639.tar.gz
compiler: add option to add implicit directory tags
GitHub: closes #7
-rw-r--r--compiler/src/Compiler.hs2
-rw-r--r--compiler/src/Config.hs2
-rw-r--r--compiler/src/Files.hs7
-rw-r--r--compiler/src/Resource.hs22
-rw-r--r--example/gallery.yaml2
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
43data CompilerConfig = CompilerConfig 43data 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
49instance FromJSON CompilerConfig where 50instance 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
24module Files 24module 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])
80fileName :: Path -> FileName 81fileName :: Path -> FileName
81fileName (Path (name:_)) = name 82fileName (Path (name:_)) = name
82 83
84maybeFileName :: Path -> Maybe FileName
85maybeFileName (Path (name:_)) = Just name
86maybeFileName _ = Nothing
87
83subPaths :: Path -> [Path] 88subPaths :: Path -> [Path]
84subPaths (Path path) = map Path $ subsequences path 89subPaths (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
106buildGalleryTree :: 106buildGalleryTree ::
107 DirProcessor -> ItemProcessor -> ThumbnailProcessor 107 DirProcessor -> ItemProcessor -> ThumbnailProcessor
108 -> String -> InputTree -> IO GalleryItem 108 -> Bool -> String -> InputTree -> IO GalleryItem
109buildGalleryTree processDir processItem processThumbnail galleryName inputTree = 109buildGalleryTree 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
159flattenGalleryTree :: GalleryItem -> [GalleryItem] 163flattenGalleryTree :: GalleryItem -> [GalleryItem]
160flattenGalleryTree dir@(GalleryItem _ _ _ _ _ _ (Directory items)) = 164flattenGalleryTree 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 @@
1compiler: 1compiler:
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