aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs43
1 files changed, 18 insertions, 25 deletions
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))