diff options
-rw-r--r-- | compiler/src/Processors.hs | 21 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 28 | ||||
-rw-r--r-- | design-notes.md | 9 |
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 | |||
27 | import Control.Exception (Exception) | 27 | import Control.Exception (Exception) |
28 | import Data.Function ((&)) | 28 | import Data.Function ((&)) |
29 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
30 | import Data.List (break) | ||
30 | 31 | ||
31 | import System.Directory hiding (copyFile) | 32 | import System.Directory hiding (copyFile) |
32 | import qualified System.Directory | 33 | import qualified System.Directory |
33 | import System.FilePath | 34 | import System.FilePath |
34 | 35 | ||
35 | import System.Process (callProcess) | 36 | import System.Process (callProcess, readProcess) |
36 | 37 | ||
37 | import Resource | 38 | import Resource |
38 | ( ItemProcessor, ThumbnailProcessor | 39 | ( ItemProcessor, ThumbnailProcessor |
39 | , GalleryItemProps(..), Resolution(..), Resource(..) ) | 40 | , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) ) |
40 | 41 | ||
41 | import Files | 42 | import Files |
42 | 43 | ||
@@ -119,6 +120,12 @@ withCached processor inputPath outputPath = | |||
119 | resourceAt :: FilePath -> Path -> IO Resource | 120 | resourceAt :: FilePath -> Path -> IO Resource |
120 | resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath | 121 | resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath |
121 | 122 | ||
123 | getImageResolution :: FilePath -> IO Resolution | ||
124 | getImageResolution fsPath = | ||
125 | readProcess "identify" ["-format", "%w %h", fsPath] [] | ||
126 | >>= return . break (== ' ') | ||
127 | >>= return . \(w, h) -> Resolution (read w) (read h) | ||
128 | |||
122 | 129 | ||
123 | type ItemFileProcessor = | 130 | type 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 | ||
19 | module Resource | 19 | module 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 | ||
93 | data Thumbnail = Thumbnail | ||
94 | { resource :: Resource | ||
95 | , resolution :: Resolution | ||
96 | } deriving (Generic, Show) | ||
97 | |||
98 | instance ToJSON Thumbnail where | ||
99 | toJSON = genericToJSON encodingOptions | ||
100 | toEncoding = genericToEncoding encodingOptions | ||
101 | |||
102 | |||
93 | data GalleryItem = GalleryItem | 103 | data 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 | ||
108 | type ItemProcessor = Path -> IO GalleryItemProps | 118 | type ItemProcessor = Path -> IO GalleryItemProps |
109 | type ThumbnailProcessor = Path -> IO (Maybe Resource) | 119 | type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) |
110 | 120 | ||
111 | 121 | ||
112 | buildGalleryTree :: | 122 | buildGalleryTree :: |
@@ -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 | ||
206 | galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () | 222 | galleryCleanupResourceDir :: 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", |