aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
authorpacien2020-02-17 18:09:20 +0100
committerpacien2020-02-23 22:41:40 +0100
commit68899f0c1ba4f641c376fda1e51d9694b02b9c5d (patch)
treed1fb9d413d20583bfa94810582d66b381ba3c8c7 /compiler/src
parentcefb6c102d4f23f02f5fabb934d7e9f60861044e (diff)
downloadldgallery-68899f0c1ba4f641c376fda1e51d9694b02b9c5d.tar.gz
compiler: add a prefix setting for tags generated from parent dirs
GitHub: closes #59
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Config.hs26
-rw-r--r--compiler/src/Resource.hs43
2 files changed, 40 insertions, 29 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 @@
19module Config 19module Config
20 ( GalleryConfig(..) 20 ( GalleryConfig(..)
21 , CompilerConfig(..) 21 , CompilerConfig(..)
22 , TagsFromDirectoriesConfig(..)
23 , Resolution(..)
22 , readConfig 24 , readConfig
23 ) where 25 ) where
24 26
25 27
26import GHC.Generics (Generic) 28import GHC.Generics (Generic)
27import Data.Aeson (FromJSON, withObject, (.:?), (.!=)) 29import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=))
28import qualified Data.Aeson as JSON 30import qualified Data.Aeson as JSON
29 31
30import Files (FileName) 32import Files (FileName)
31import Input (decodeYamlFile) 33import Input (decodeYamlFile)
32import Resource (Resolution(..)) 34
35
36data Resolution = Resolution
37 { width :: Int
38 , height :: Int
39 } deriving (Generic, Show, ToJSON, FromJSON)
33 40
34 41
35data CompilerConfig = CompilerConfig 42data CompilerConfig = CompilerConfig
@@ -37,7 +44,7 @@ data CompilerConfig = CompilerConfig
37 , excludedDirectories :: [String] 44 , excludedDirectories :: [String]
38 , includedFiles :: [String] 45 , includedFiles :: [String]
39 , excludedFiles :: [String] 46 , excludedFiles :: [String]
40 , tagsFromDirectories :: Int 47 , tagsFromDirectories :: TagsFromDirectoriesConfig
41 , thumbnailMaxResolution :: Resolution 48 , thumbnailMaxResolution :: Resolution
42 , pictureMaxResolution :: Maybe Resolution 49 , pictureMaxResolution :: Maybe Resolution
43 } deriving (Generic, Show) 50 } deriving (Generic, Show)
@@ -48,11 +55,22 @@ instance FromJSON CompilerConfig where
48 <*> v .:? "excludedDirectories" .!= [] 55 <*> v .:? "excludedDirectories" .!= []
49 <*> v .:? "includedFiles" .!= ["*"] 56 <*> v .:? "includedFiles" .!= ["*"]
50 <*> v .:? "excludedFiles" .!= [] 57 <*> v .:? "excludedFiles" .!= []
51 <*> v .:? "tagsFromDirectories" .!= 0 58 <*> v .:? "tagsFromDirectories" .!= (TagsFromDirectoriesConfig 0 "")
52 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300) 59 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300)
53 <*> v .:? "pictureMaxResolution" 60 <*> v .:? "pictureMaxResolution"
54 61
55 62
63data TagsFromDirectoriesConfig = TagsFromDirectoriesConfig
64 { fromParents :: Int
65 , prefix :: String
66 } deriving (Generic, Show)
67
68instance FromJSON TagsFromDirectoriesConfig where
69 parseJSON = withObject "TagsFromDirectoriesConfig" $ \v -> TagsFromDirectoriesConfig
70 <$> v .:? "fromParents" .!= 0
71 <*> v .:? "prefix" .!= ""
72
73
56data GalleryConfig = GalleryConfig 74data GalleryConfig = GalleryConfig
57 { compiler :: CompilerConfig 75 { compiler :: CompilerConfig
58 , viewer :: JSON.Object 76 , 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)
27import Data.List (sortOn) 27import Data.List (sortOn)
28import Data.List.Ordered (minusBy) 28import Data.List.Ordered (minusBy)
29import Data.Char (toLower) 29import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe, maybeToList) 30import Data.Maybe (mapMaybe, fromMaybe)
31import Data.Function ((&)) 31import Data.Function ((&))
32import qualified Data.Set as Set 32import qualified Data.Set as Set
33import Data.Text (pack) 33import Data.Text (pack)
@@ -37,10 +37,11 @@ import Data.Time.Format (formatTime, defaultTimeLocale)
37import Safe.Foldable (maximumByMay) 37import Safe.Foldable (maximumByMay)
38 38
39import GHC.Generics (Generic) 39import GHC.Generics (Generic)
40import Data.Aeson (FromJSON, ToJSON, genericToJSON, genericToEncoding) 40import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
41import qualified Data.Aeson as JSON 41import qualified Data.Aeson as JSON
42 42
43import Files 43import Files
44import Config (Resolution(..), TagsFromDirectoriesConfig(..))
44import Input (InputTree(..), Sidecar(..)) 45import Input (InputTree(..), Sidecar(..))
45 46
46 47
@@ -57,16 +58,6 @@ encodingOptions = JSON.defaultOptions
57 58
58type Tag = String 59type Tag = String
59 60
60data Resolution = Resolution
61 { width :: Int
62 , height :: Int
63 } deriving (Generic, Show, FromJSON)
64
65instance ToJSON Resolution where
66 toJSON = genericToJSON encodingOptions
67 toEncoding = genericToEncoding encodingOptions
68
69
70data Resource = Resource 61data Resource = Resource
71 { resourcePath :: Path 62 { resourcePath :: Path
72 , modTime :: UTCTime 63 , modTime :: UTCTime
@@ -120,13 +111,13 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
120 111
121 112
122buildGalleryTree :: 113buildGalleryTree ::
123 ItemProcessor -> ThumbnailProcessor 114 ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig
124 -> Int -> InputTree -> IO GalleryItem 115 -> InputTree -> IO GalleryItem
125buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree = 116buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree =
126 mkGalleryItem [] [] inputTree 117 mkGalleryItem [] inputTree
127 where 118 where
128 mkGalleryItem :: [String] -> [Tag] -> InputTree -> IO GalleryItem 119 mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
129 mkGalleryItem parentDirs inheritedTags InputFile{path, modTime, sidecar} = 120 mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} =
130 do 121 do
131 properties <- processItem path 122 properties <- processItem path
132 processedThumbnail <- processThumbnail path 123 processedThumbnail <- processThumbnail path
@@ -134,23 +125,22 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree =
134 { title = Input.title sidecar ?? fileName path ?? "" 125 { title = Input.title sidecar ?? fileName path ?? ""
135 , datetime = Input.datetime sidecar ?? toZonedTime modTime 126 , datetime = Input.datetime sidecar ?? toZonedTime modTime
136 , description = Input.description sidecar ?? "" 127 , description = Input.description sidecar ?? ""
137 , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags parentDirs) 128 , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path)
138 , path = "/" /> path 129 , path = "/" /> path
139 , thumbnail = processedThumbnail 130 , thumbnail = processedThumbnail
140 , properties = properties } 131 , properties = properties }
141 132
142 mkGalleryItem parentDirs inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = 133 mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} =
143 do 134 do
144 let itemsParents = (maybeToList $ fileName path) ++ parentDirs
145 let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags 135 let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
146 processedItems <- parallel $ map (mkGalleryItem itemsParents dirTags) items 136 processedItems <- parallel $ map (mkGalleryItem dirTags) items
147 processedThumbnail <- maybeThumbnail dirThumbnailPath 137 processedThumbnail <- maybeThumbnail dirThumbnailPath
148 return GalleryItem 138 return GalleryItem
149 { title = Input.title sidecar ?? fileName path ?? "" 139 { title = Input.title sidecar ?? fileName path ?? ""
150 , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems 140 , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
151 ?? toZonedTime modTime 141 ?? toZonedTime modTime
152 , description = Input.description sidecar ?? "" 142 , description = Input.description sidecar ?? ""
153 , tags = unique (aggregateTags processedItems ++ parentDirTags parentDirs) 143 , tags = unique (aggregateTags processedItems ++ parentDirTags path)
154 , path = "/" /> path 144 , path = "/" /> path
155 , thumbnail = processedThumbnail 145 , thumbnail = processedThumbnail
156 , properties = Directory processedItems } 146 , properties = Directory processedItems }
@@ -162,8 +152,11 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories inputTree =
162 unique :: Ord a => [a] -> [a] 152 unique :: Ord a => [a] -> [a]
163 unique = Set.toList . Set.fromList 153 unique = Set.toList . Set.fromList
164 154
165 parentDirTags :: [String] -> [Tag] 155 parentDirTags :: Path -> [Tag]
166 parentDirTags = take tagsFromDirectories 156 parentDirTags (Path elements) =
157 drop 1 elements
158 & take (fromParents tagsFromDirsConfig)
159 & map (prefix tagsFromDirsConfig ++)
167 160
168 aggregateTags :: [GalleryItem] -> [Tag] 161 aggregateTags :: [GalleryItem] -> [Tag]
169 aggregateTags = concatMap (\item -> tags (item::GalleryItem)) 162 aggregateTags = concatMap (\item -> tags (item::GalleryItem))