From 68899f0c1ba4f641c376fda1e51d9694b02b9c5d Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 17 Feb 2020 18:09:20 +0100 Subject: compiler: add a prefix setting for tags generated from parent dirs GitHub: closes #59 --- compiler/src/Config.hs | 26 ++++++++++++++++++++++---- compiler/src/Resource.hs | 43 ++++++++++++++++++------------------------- example/src/gallery.yaml | 4 +++- ldgallery.1.md | 27 +++++++++++++++++++-------- 4 files changed, 62 insertions(+), 38 deletions(-) diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 4826f17..bf5a28e 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs @@ -19,17 +19,24 @@ module Config ( GalleryConfig(..) , CompilerConfig(..) + , TagsFromDirectoriesConfig(..) + , Resolution(..) , readConfig ) where import GHC.Generics (Generic) -import Data.Aeson (FromJSON, withObject, (.:?), (.!=)) +import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=)) import qualified Data.Aeson as JSON import Files (FileName) import Input (decodeYamlFile) -import Resource (Resolution(..)) + + +data Resolution = Resolution + { width :: Int + , height :: Int + } deriving (Generic, Show, ToJSON, FromJSON) data CompilerConfig = CompilerConfig @@ -37,7 +44,7 @@ data CompilerConfig = CompilerConfig , excludedDirectories :: [String] , includedFiles :: [String] , excludedFiles :: [String] - , tagsFromDirectories :: Int + , tagsFromDirectories :: TagsFromDirectoriesConfig , thumbnailMaxResolution :: Resolution , pictureMaxResolution :: Maybe Resolution } deriving (Generic, Show) @@ -48,11 +55,22 @@ instance FromJSON CompilerConfig where <*> v .:? "excludedDirectories" .!= [] <*> v .:? "includedFiles" .!= ["*"] <*> v .:? "excludedFiles" .!= [] - <*> v .:? "tagsFromDirectories" .!= 0 + <*> v .:? "tagsFromDirectories" .!= (TagsFromDirectoriesConfig 0 "") <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300) <*> v .:? "pictureMaxResolution" +data TagsFromDirectoriesConfig = TagsFromDirectoriesConfig + { fromParents :: Int + , prefix :: String + } deriving (Generic, Show) + +instance FromJSON TagsFromDirectoriesConfig where + parseJSON = withObject "TagsFromDirectoriesConfig" $ \v -> TagsFromDirectoriesConfig + <$> v .:? "fromParents" .!= 0 + <*> v .:? "prefix" .!= "" + + data GalleryConfig = GalleryConfig { compiler :: CompilerConfig , viewer :: JSON.Object diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index aadf60b..b2a6bbf 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -27,7 +27,7 @@ import Control.Concurrent.ParallelIO.Global (parallel) import Data.List (sortOn) import Data.List.Ordered (minusBy) import Data.Char (toLower) -import Data.Maybe (mapMaybe, fromMaybe, maybeToList) +import Data.Maybe (mapMaybe, fromMaybe) import Data.Function ((&)) import qualified Data.Set as Set import Data.Text (pack) @@ -37,10 +37,11 @@ import Data.Time.Format (formatTime, defaultTimeLocale) import Safe.Foldable (maximumByMay) import GHC.Generics (Generic) -import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding) +import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) import qualified Data.Aeson as JSON import Files +import Config (Resolution(..), TagsFromDirectoriesConfig(..)) import Input (InputTree(..), Sidecar(..)) @@ -57,16 +58,6 @@ encodingOptions = JSON.defaultOptions type Tag = String -data Resolution = Resolution - { width :: Int - , height :: Int - } deriving (Generic, Show, FromJSON) - -instance ToJSON Resolution where - toJSON = genericToJSON encodingOptions - toEncoding = genericToEncoding encodingOptions - - data Resource = Resource { resourcePath :: Path , modTime :: UTCTime @@ -120,13 +111,13 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) buildGalleryTree :: - ItemProcessor -> ThumbnailProcessor - -> Int -> InputTree -> IO GalleryItem -buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree = - mkGalleryItem [] [] inputTree + ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig + -> InputTree -> IO GalleryItem +buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree = + mkGalleryItem [] inputTree where - mkGalleryItem :: [String] -> [Tag] -> InputTree -> IO GalleryItem - mkGalleryItem parentDirs inheritedTags InputFile{path, modTime, sidecar} = + mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem + mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = do properties <- processItem path processedThumbnail <- processThumbnail path @@ -134,23 +125,22 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree = { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? toZonedTime modTime , description = Input.description sidecar ?? "" - , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags parentDirs) + , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path) , path = "/" /> path , thumbnail = processedThumbnail , properties = properties } - mkGalleryItem parentDirs inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = + mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = do - let itemsParents = (maybeToList $ fileName path) ++ parentDirs let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags - processedItems <- parallel $ map (mkGalleryItem itemsParents dirTags) items + processedItems <- parallel $ map (mkGalleryItem dirTags) items processedThumbnail <- maybeThumbnail dirThumbnailPath return GalleryItem { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems ?? toZonedTime modTime , description = Input.description sidecar ?? "" - , tags = unique (aggregateTags processedItems ++ parentDirTags parentDirs) + , tags = unique (aggregateTags processedItems ++ parentDirTags path) , path = "/" /> path , thumbnail = processedThumbnail , properties = Directory processedItems } @@ -162,8 +152,11 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree = unique :: Ord a => [a] -> [a] unique = Set.toList . Set.fromList - parentDirTags :: [String] -> [Tag] - parentDirTags = take tagsFromDirectories + parentDirTags :: Path -> [Tag] + parentDirTags (Path elements) = + drop 1 elements + & take (fromParents tagsFromDirsConfig) + & map (prefix tagsFromDirsConfig ++) aggregateTags :: [GalleryItem] -> [Tag] aggregateTags = concatMap (\item -> tags (item::GalleryItem)) diff --git a/example/src/gallery.yaml b/example/src/gallery.yaml index bef19e0..3408571 100644 --- a/example/src/gallery.yaml +++ b/example/src/gallery.yaml @@ -8,7 +8,9 @@ compiler: #excludedFiles: #- "*.md" - tagsFromDirectories: 0 # default + tagsFromDirectories: + fromParents: 0 # default + prefix: "" # default thumbnailMaxResolution: width: 400 # default diff --git a/ldgallery.1.md b/ldgallery.1.md index 91724a6..a5d0e4c 100644 --- a/ldgallery.1.md +++ b/ldgallery.1.md @@ -107,19 +107,28 @@ tags The gallery settings reside in a file named "gallery.yaml" located at the root of the gallery's source directory. compiler.includedDirectories[] -: Glob patterns of directory names to include in the gallery. Defaults to ["*"] (matches all directory names). +: Glob patterns of directory names to include in the gallery. + Defaults to ["*"] (matches all directory names). compiler.excludedDirectories[] -: Glob patterns of directory names to exclude from the gallery. Defaults to [] (none). +: Glob patterns of directory names to exclude from the gallery. + Defaults to [] (none). compiler.includedFiles[] -: Glob patterns of file names to include in the gallery. Defaults to ["*"] (matches all file names). +: Glob patterns of file names to include in the gallery. + Defaults to ["*"] (matches all file names). compiler.excludedFiles[] -: Glob patterns of file names to exclude from the gallery. Defaults to [] (none). +: Glob patterns of file names to exclude from the gallery. + Defaults to [] (none). -compiler.tagsFromDirectories -: How far to look at parent directories to add implicit tags. Defaults to 0. +compiler.tagsFromDirectories.fromParents +: Automatically generate tags from the name of parent directories, + looking up in the hierarchy as far as indicated by this parameter. + Defaults to 0 (do not generate tags from parent directories). + +compiler.tagsFromDirectories.prefix +: Prefix to use for tags automatically generated from the parent directories' names. compiler.thumbnailMaxResolution.width : Maximum width in pixels of the item thumbnails, 400 by default. @@ -137,7 +146,8 @@ viewer.defaultSearchQuery [TODO] : Default search query string. viewer.defaultSortOrder [TODO] -: Default sort order ("alphanumeric", "reverse-alphanumeric", "date", "reverse-date"). Defaults to "date". +: Default sort order ("alphanumeric", "reverse-alphanumeric", "date", "reverse-date"). + Defaults to "date". viewer.tagGroups[].tag [TODO] : Tag prefix defining the tag group. @@ -146,7 +156,8 @@ viewer.tagGroups[].colour [TODO] : Colour associated to the tag group. viewer.hiddenTags [TODO] -: List of tags to hide by default. Items bearing one of those tags will not be displayed until they are being explicitly searched for. +: List of tags to hide by default. + Items bearing one of those tags will not be displayed until they are being explicitly searched for. # SEE ALSO -- cgit v1.2.3