aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/src/Compiler.hs2
-rw-r--r--compiler/src/Config.hs4
-rw-r--r--compiler/src/Resource.hs31
3 files changed, 16 insertions, 21 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index d0ec003..fc4e272 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -111,7 +111,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
111 111
112 let itemProc = itemProcessor (pictureMaxResolution config) cache 112 let itemProc = itemProcessor (pictureMaxResolution config) cache
113 let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache 113 let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
114 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (implicitDirectoryTag config) 114 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
115 resources <- galleryBuilder (galleryName config) inputTree 115 resources <- galleryBuilder (galleryName config) inputTree
116 116
117 galleryCleanupResourceDir resources outputDirPath 117 galleryCleanupResourceDir resources outputDirPath
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index b9434ba..20bc3bb 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -35,7 +35,7 @@ import Resource (Resolution(..))
35data CompilerConfig = CompilerConfig 35data CompilerConfig = CompilerConfig
36 { galleryName :: String 36 { galleryName :: String
37 , ignoreFiles :: String 37 , ignoreFiles :: String
38 , implicitDirectoryTag :: Bool 38 , tagsFromDirectories :: Int
39 , thumbnailMaxResolution :: Resolution 39 , thumbnailMaxResolution :: Resolution
40 , pictureMaxResolution :: Maybe Resolution 40 , pictureMaxResolution :: Maybe Resolution
41 } deriving (Generic, Show) 41 } deriving (Generic, Show)
@@ -44,7 +44,7 @@ instance FromJSON CompilerConfig where
44 parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig 44 parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig
45 <$> v .:? "galleryName" .!= "Gallery" 45 <$> v .:? "galleryName" .!= "Gallery"
46 <*> v .:? "ignoreFiles" .!= ".^" 46 <*> v .:? "ignoreFiles" .!= ".^"
47 <*> v .:? "implicitDirectoryTag" .!= False 47 <*> v .:? "tagsFromDirectories" .!= 0
48 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400) 48 <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 400)
49 <*> v .:? "pictureMaxResolution" 49 <*> v .:? "pictureMaxResolution"
50 50
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 2019418..261191b 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -27,7 +27,7 @@ import Control.Concurrent.ParallelIO.Global (parallel)
27import Data.List ((\\), sortBy) 27import Data.List ((\\), sortBy)
28import Data.Ord (comparing) 28import Data.Ord (comparing)
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
33 33
@@ -94,15 +94,12 @@ type ThumbnailProcessor = Path -> IO (Maybe Path)
94 94
95buildGalleryTree :: 95buildGalleryTree ::
96 ItemProcessor -> ThumbnailProcessor 96 ItemProcessor -> ThumbnailProcessor
97 -> Bool -> String -> InputTree -> IO GalleryItem 97 -> Int -> String -> InputTree -> IO GalleryItem
98buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree = 98buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName inputTree =
99 mkGalleryItem (Path []) inputTree >>= return . named galleryName 99 mkGalleryItem (Just galleryName) (Path []) inputTree
100 where 100 where
101 named :: String -> GalleryItem -> GalleryItem 101 mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
102 named name item = item { title = name } 102 mkGalleryItem _ parents InputFile{path, sidecar} =
103
104 mkGalleryItem :: Path -> InputTree -> IO GalleryItem
105 mkGalleryItem parents InputFile{path, sidecar} =
106 do 103 do
107 properties <- processItem path 104 properties <- processItem path
108 processedThumbnail <- processThumbnail path 105 processedThumbnail <- processThumbnail path
@@ -110,7 +107,7 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
110 { title = itemTitle 107 { title = itemTitle
111 , date = optMeta date "" -- TODO: check and normalise dates 108 , date = optMeta date "" -- TODO: check and normalise dates
112 , description = optMeta description "" 109 , description = optMeta description ""
113 , tags = (optMeta tags []) ++ implicitParentTag parents 110 , tags = (optMeta tags []) ++ implicitParentTags parents
114 , path = parents </ itemTitle 111 , path = parents </ itemTitle
115 , thumbnail = processedThumbnail 112 , thumbnail = processedThumbnail
116 , properties = properties } -- TODO 113 , properties = properties } -- TODO
@@ -121,23 +118,23 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
121 optMeta :: (Sidecar -> Maybe a) -> a -> a 118 optMeta :: (Sidecar -> Maybe a) -> a -> a
122 optMeta get fallback = fromMaybe fallback $ get sidecar 119 optMeta get fallback = fromMaybe fallback $ get sidecar
123 120
124 mkGalleryItem parents InputDir{path, dirThumbnailPath, items} = 121 mkGalleryItem rootTitle parents InputDir{path, dirThumbnailPath, items} =
125 do 122 do
126 processedThumbnail <- maybeThumbnail dirThumbnailPath 123 processedThumbnail <- maybeThumbnail dirThumbnailPath
127 processedItems <- parallel $ map (mkGalleryItem itemPath) items 124 processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
128 return GalleryItem 125 return GalleryItem
129 { title = itemTitle 126 { title = itemTitle
130 -- TODO: consider using the most recent item's date? what if empty? 127 -- TODO: consider using the most recent item's date? what if empty?
131 , date = "" 128 , date = ""
132 -- TODO: consider allowing metadata sidecars for directories too 129 -- TODO: consider allowing metadata sidecars for directories too
133 , description = "" 130 , description = ""
134 , tags = (aggregateChildTags processedItems) ++ implicitParentTag parents 131 , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
135 , path = itemPath 132 , path = itemPath
136 , thumbnail = processedThumbnail 133 , thumbnail = processedThumbnail
137 , properties = Directory processedItems } 134 , properties = Directory processedItems }
138 where 135 where
139 itemTitle :: String 136 itemTitle :: String
140 itemTitle = fromMaybe "" $ fileName path 137 itemTitle = flip fromMaybe rootTitle (fromMaybe "" $ fileName path)
141 138
142 itemPath :: Path 139 itemPath :: Path
143 itemPath = parents </ itemTitle 140 itemPath = parents </ itemTitle
@@ -152,10 +149,8 @@ buildGalleryTree processItem processThumbnail addDirTag galleryName inputTree =
152 unique :: Ord a => [a] -> [a] 149 unique :: Ord a => [a] -> [a]
153 unique = Set.toList . Set.fromList 150 unique = Set.toList . Set.fromList
154 151
155 implicitParentTag :: Path -> [Tag] 152 implicitParentTags :: Path -> [Tag]
156 implicitParentTag parents 153 implicitParentTags (Path elements) = take tagsFromDirectories elements
157 | addDirTag = maybeToList $ fileName parents
158 | otherwise = []
159 154
160 155
161flattenGalleryTree :: GalleryItem -> [GalleryItem] 156flattenGalleryTree :: GalleryItem -> [GalleryItem]