aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpacien2020-01-31 19:43:24 +0100
committerpacien2020-01-31 19:43:24 +0100
commit7dde692101a7e36e0a431aeb864cbf3a0c0e96f8 (patch)
treec16d53fb67ecad8693b219662a18b67852a19ed2
parent245fee3fe5abdc6ad14513ef6522446aba4c905a (diff)
downloadldgallery-7dde692101a7e36e0a431aeb864cbf3a0c0e96f8.tar.gz
compiler: add thumbnail size to index
-rw-r--r--compiler/src/Processors.hs21
-rw-r--r--compiler/src/Resource.hs28
-rw-r--r--design-notes.md9
3 files changed, 45 insertions, 13 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index f2ade63..9ddc6ee 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -27,16 +27,17 @@ module Processors
27import Control.Exception (Exception) 27import Control.Exception (Exception)
28import Data.Function ((&)) 28import Data.Function ((&))
29import Data.Char (toLower) 29import Data.Char (toLower)
30import Data.List (break)
30 31
31import System.Directory hiding (copyFile) 32import System.Directory hiding (copyFile)
32import qualified System.Directory 33import qualified System.Directory
33import System.FilePath 34import System.FilePath
34 35
35import System.Process (callProcess) 36import System.Process (callProcess, readProcess)
36 37
37import Resource 38import Resource
38 ( ItemProcessor, ThumbnailProcessor 39 ( ItemProcessor, ThumbnailProcessor
39 , GalleryItemProps(..), Resolution(..), Resource(..) ) 40 , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) )
40 41
41import Files 42import Files
42 43
@@ -119,6 +120,12 @@ withCached processor inputPath outputPath =
119resourceAt :: FilePath -> Path -> IO Resource 120resourceAt :: FilePath -> Path -> IO Resource
120resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath 121resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
121 122
123getImageResolution :: FilePath -> IO Resolution
124getImageResolution fsPath =
125 readProcess "identify" ["-format", "%w %h", fsPath] []
126 >>= return . break (== ' ')
127 >>= return . \(w, h) -> Resolution (read w) (read h)
128
122 129
123type ItemFileProcessor = 130type ItemFileProcessor =
124 FileName -- ^ Input base path 131 FileName -- ^ Input base path
@@ -158,12 +165,14 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
158 inPath = localPath $ inputBase /> inputRes 165 inPath = localPath $ inputBase /> inputRes
159 outPath = localPath $ outputBase /> relOutPath 166 outPath = localPath $ outputBase /> relOutPath
160 167
161 process :: Maybe FileProcessor -> IO (Maybe Resource) 168 process :: Maybe FileProcessor -> IO (Maybe Thumbnail)
162 process Nothing = return Nothing 169 process Nothing = return Nothing
163 process (Just proc) = 170 process (Just proc) =
164 proc inPath outPath 171 do
165 >> resourceAt outPath relOutPath 172 proc inPath outPath
166 >>= return . Just 173 resource <- resourceAt outPath relOutPath
174 resolution <- getImageResolution outPath
175 return $ Just $ Thumbnail resource resolution
167 176
168 processorFor :: Format -> Maybe FileProcessor 177 processorFor :: Format -> Maybe FileProcessor
169 processorFor PictureFormat = Just $ resizePictureUpTo maxRes 178 processorFor PictureFormat = Just $ resizePictureUpTo maxRes
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index c0ef317..33f3cf0 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
18 18
19module Resource 19module Resource
20 ( ItemProcessor, ThumbnailProcessor 20 ( ItemProcessor, ThumbnailProcessor
21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..) 21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
22 , buildGalleryTree, galleryCleanupResourceDir 22 , buildGalleryTree, galleryCleanupResourceDir
23 ) where 23 ) where
24 24
@@ -90,13 +90,23 @@ instance ToJSON GalleryItemProps where
90 toEncoding = genericToEncoding encodingOptions 90 toEncoding = genericToEncoding encodingOptions
91 91
92 92
93data Thumbnail = Thumbnail
94 { resource :: Resource
95 , resolution :: Resolution
96 } deriving (Generic, Show)
97
98instance ToJSON Thumbnail where
99 toJSON = genericToJSON encodingOptions
100 toEncoding = genericToEncoding encodingOptions
101
102
93data GalleryItem = GalleryItem 103data GalleryItem = GalleryItem
94 { title :: String 104 { title :: String
95 , datetime :: ZonedTime 105 , datetime :: ZonedTime
96 , description :: String 106 , description :: String
97 , tags :: [Tag] 107 , tags :: [Tag]
98 , path :: Path 108 , path :: Path
99 , thumbnail :: Maybe Resource 109 , thumbnail :: Maybe Thumbnail
100 , properties :: GalleryItemProps 110 , properties :: GalleryItemProps
101 } deriving (Generic, Show) 111 } deriving (Generic, Show)
102 112
@@ -106,7 +116,7 @@ instance ToJSON GalleryItem where
106 116
107 117
108type ItemProcessor = Path -> IO GalleryItemProps 118type ItemProcessor = Path -> IO GalleryItemProps
109type ThumbnailProcessor = Path -> IO (Maybe Resource) 119type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
110 120
111 121
112buildGalleryTree :: 122buildGalleryTree ::
@@ -150,7 +160,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
150 subItemsParents :: [String] 160 subItemsParents :: [String]
151 subItemsParents = (maybeToList $ fileName path) ++ parentTitles 161 subItemsParents = (maybeToList $ fileName path) ++ parentTitles
152 162
153 maybeThumbnail :: Maybe Path -> IO (Maybe Resource) 163 maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
154 maybeThumbnail Nothing = return Nothing 164 maybeThumbnail Nothing = return Nothing
155 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath 165 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
156 166
@@ -197,10 +207,16 @@ galleryOutputDiff resources ref =
197 207
198 resPath :: GalleryItemProps -> Maybe Path 208 resPath :: GalleryItemProps -> Maybe Path
199 resPath Directory{} = Nothing 209 resPath Directory{} = Nothing
200 resPath resourceProps = Just (resourcePath $ resource resourceProps) 210 resPath resourceProps =
211 Just
212 $ resourcePath
213 $ (resource :: (GalleryItemProps -> Resource)) resourceProps
201 214
202 thumbnailPaths :: [GalleryItem] -> [Path] 215 thumbnailPaths :: [GalleryItem] -> [Path]
203 thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) 216 thumbnailPaths =
217 map resourcePath
218 . map (resource :: (Thumbnail -> Resource))
219 . mapMaybe thumbnail
204 220
205 221
206galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () 222galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
diff --git a/design-notes.md b/design-notes.md
index 91764cc..d59f511 100644
--- a/design-notes.md
+++ b/design-notes.md
@@ -143,7 +143,14 @@ Serialised item structure:
143 ], 143 ],
144 144
145 "path": "[resource path]", 145 "path": "[resource path]",
146 "thumbnail": "[resource path | null]", 146
147 "thumbnail": null | {
148 "resource": "[resource path]",
149 "resolution": {
150 "width": 400,
151 "height": 200
152 }
153 },
147 154
148 155
149 "_comment": "type-dependent", 156 "_comment": "type-dependent",