aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Compiler.hs9
-rw-r--r--compiler/src/Processors.hs32
-rw-r--r--compiler/src/Resource.hs10
3 files changed, 26 insertions, 25 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 048afc1..f15192f 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -37,7 +37,7 @@ import qualified Data.Aeson as JSON
37 37
38import Config 38import Config
39import Input (decodeYamlFile, readInputTree) 39import Input (decodeYamlFile, readInputTree)
40import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) 40import Resource (buildGalleryTree, galleryCleanupResourceDir)
41import Files 41import Files
42 ( FileName 42 ( FileName
43 , FSNode(..) 43 , FSNode(..)
@@ -48,11 +48,8 @@ import Files
48 , ensureParentDir 48 , ensureParentDir
49 , isOutdated ) 49 , isOutdated )
50import Processors 50import Processors
51 ( dirFileProcessor 51 ( dirFileProcessor, itemFileProcessor, thumbnailFileProcessor
52 , itemFileProcessor 52 , skipCached, withCached )
53 , thumbnailFileProcessor
54 , skipCached
55 , withCached )
56 53
57 54
58writeJSON :: ToJSON a => FileName -> a -> IO () 55writeJSON :: ToJSON a => FileName -> a -> IO ()
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index df05c24..dab9aaa 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -45,6 +45,9 @@ import Codec.Picture
45import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) 45import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
46 46
47import Resource 47import Resource
48 ( DirProcessor, ItemProcessor, ThumbnailProcessor
49 , GalleryItemProps(..), Resolution(..) )
50
48import Files 51import Files
49 52
50 53
@@ -54,7 +57,7 @@ instance Exception ProcessingException
54data Format = 57data Format =
55 Bmp | Jpg | Png | Tiff | Hdr -- static images 58 Bmp | Jpg | Png | Tiff | Hdr -- static images
56 | Gif -- TODO: might be animated 59 | Gif -- TODO: might be animated
57 | Other 60 | Unknown
58 61
59formatFromPath :: Path -> Format 62formatFromPath :: Path -> Format
60formatFromPath = aux . (map toLower) . takeExtension . fileName 63formatFromPath = aux . (map toLower) . takeExtension . fileName
@@ -66,7 +69,7 @@ formatFromPath = aux . (map toLower) . takeExtension . fileName
66 aux ".tiff" = Tiff 69 aux ".tiff" = Tiff
67 aux ".hdr" = Hdr 70 aux ".hdr" = Hdr
68 aux ".gif" = Gif 71 aux ".gif" = Gif
69 aux _ = Other 72 aux _ = Unknown
70 73
71 74
72type FileProcessor = 75type FileProcessor =
@@ -163,22 +166,23 @@ type ItemFileProcessor =
163 166
164itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor 167itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
165itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = 168itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
166 cached (processor maxRes (formatFromPath inputRes)) inPath outPath 169 cached processor inPath outPath
167 >> return relOutPath 170 >> return (relOutPath, props)
168 where 171 where
169 relOutPath = resClass /> inputRes 172 relOutPath = resClass /> inputRes
170 inPath = localPath $ inputBase /> inputRes 173 inPath = localPath $ inputBase /> inputRes
171 outPath = localPath $ outputBase /> relOutPath 174 outPath = localPath $ outputBase /> relOutPath
172 175 (processor, props) = formatProcessor maxRes $ formatFromPath inputRes
173 processor :: Maybe Resolution -> Format -> FileProcessor 176
174 processor Nothing _ = copyFileProcessor 177 formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps)
175 processor (Just maxRes) Bmp = resizeStaticImageUpTo Bmp maxRes 178 formatProcessor Nothing _ = (copyFileProcessor, Other)
176 processor (Just maxRes) Jpg = resizeStaticImageUpTo Jpg maxRes 179 formatProcessor (Just maxRes) Bmp = (resizeStaticImageUpTo Bmp maxRes, Picture)
177 processor (Just maxRes) Png = resizeStaticImageUpTo Png maxRes 180 formatProcessor (Just maxRes) Jpg = (resizeStaticImageUpTo Jpg maxRes, Picture)
178 processor (Just maxRes) Tiff = resizeStaticImageUpTo Tiff maxRes 181 formatProcessor (Just maxRes) Png = (resizeStaticImageUpTo Png maxRes, Picture)
179 processor (Just maxRes) Hdr = resizeStaticImageUpTo Hdr maxRes 182 formatProcessor (Just maxRes) Tiff = (resizeStaticImageUpTo Tiff maxRes, Picture)
180 processor _ Gif = copyFileProcessor -- TODO: handle animated gif resizing 183 formatProcessor (Just maxRes) Hdr = (resizeStaticImageUpTo Hdr maxRes, Picture)
181 processor _ Other = copyFileProcessor -- TODO: handle video reencoding and others? 184 formatProcessor _ Gif = (copyFileProcessor, Other) -- TODO: handle animated gif resizing
185 formatProcessor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
182 186
183 187
184type ThumbnailFileProcessor = 188type ThumbnailFileProcessor =
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index dcf9422..bffa569 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -25,7 +25,7 @@
25 25
26module Resource 26module Resource
27 ( DirProcessor, ItemProcessor, ThumbnailProcessor 27 ( DirProcessor, ItemProcessor, ThumbnailProcessor
28 , GalleryItem, GalleryItemProps, Resolution(..) 28 , GalleryItem(..), GalleryItemProps(..), Resolution(..)
29 , buildGalleryTree, galleryCleanupResourceDir 29 , buildGalleryTree, galleryCleanupResourceDir
30 ) where 30 ) where
31 31
@@ -99,7 +99,7 @@ instance ToJSON GalleryItem where
99 99
100 100
101type DirProcessor = Path -> IO Path 101type DirProcessor = Path -> IO Path
102type ItemProcessor = Path -> IO Path 102type ItemProcessor = Path -> IO (Path, GalleryItemProps)
103type ThumbnailProcessor = Path -> IO (Maybe Path) 103type ThumbnailProcessor = Path -> IO (Maybe Path)
104 104
105 105
@@ -115,16 +115,16 @@ buildGalleryTree processDir processItem processThumbnail galleryName inputTree =
115 mkGalleryItem :: InputTree -> IO GalleryItem 115 mkGalleryItem :: InputTree -> IO GalleryItem
116 mkGalleryItem InputFile{path, sidecar} = 116 mkGalleryItem InputFile{path, sidecar} =
117 do 117 do
118 processedItem <- processItem path 118 (processedItemPath, properties) <- processItem path
119 processedThumbnail <- processThumbnail path 119 processedThumbnail <- processThumbnail path
120 return GalleryItem 120 return GalleryItem
121 { title = optMeta title $ fileName path 121 { title = optMeta title $ fileName path
122 , date = optMeta date "" -- TODO: check and normalise dates 122 , date = optMeta date "" -- TODO: check and normalise dates
123 , description = optMeta description "" 123 , description = optMeta description ""
124 , tags = optMeta tags [] 124 , tags = optMeta tags []
125 , path = processedItem 125 , path = processedItemPath
126 , thumbnail = processedThumbnail 126 , thumbnail = processedThumbnail
127 , properties = Other } -- TODO 127 , properties = properties } -- TODO
128 where 128 where
129 optMeta :: (Sidecar -> Maybe a) -> a -> a 129 optMeta :: (Sidecar -> Maybe a) -> a -> a
130 optMeta get fallback = fromMaybe fallback $ get sidecar 130 optMeta get fallback = fromMaybe fallback $ get sidecar