diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 9 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 32 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 10 |
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 | ||
38 | import Config | 38 | import Config |
39 | import Input (decodeYamlFile, readInputTree) | 39 | import Input (decodeYamlFile, readInputTree) |
40 | import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) | 40 | import Resource (buildGalleryTree, galleryCleanupResourceDir) |
41 | import Files | 41 | import Files |
42 | ( FileName | 42 | ( FileName |
43 | , FSNode(..) | 43 | , FSNode(..) |
@@ -48,11 +48,8 @@ import Files | |||
48 | , ensureParentDir | 48 | , ensureParentDir |
49 | , isOutdated ) | 49 | , isOutdated ) |
50 | import Processors | 50 | import Processors |
51 | ( dirFileProcessor | 51 | ( dirFileProcessor, itemFileProcessor, thumbnailFileProcessor |
52 | , itemFileProcessor | 52 | , skipCached, withCached ) |
53 | , thumbnailFileProcessor | ||
54 | , skipCached | ||
55 | , withCached ) | ||
56 | 53 | ||
57 | 54 | ||
58 | writeJSON :: ToJSON a => FileName -> a -> IO () | 55 | writeJSON :: 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 | |||
45 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) | 45 | import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented) |
46 | 46 | ||
47 | import Resource | 47 | import Resource |
48 | ( DirProcessor, ItemProcessor, ThumbnailProcessor | ||
49 | , GalleryItemProps(..), Resolution(..) ) | ||
50 | |||
48 | import Files | 51 | import Files |
49 | 52 | ||
50 | 53 | ||
@@ -54,7 +57,7 @@ instance Exception ProcessingException | |||
54 | data Format = | 57 | data 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 | ||
59 | formatFromPath :: Path -> Format | 62 | formatFromPath :: Path -> Format |
60 | formatFromPath = aux . (map toLower) . takeExtension . fileName | 63 | formatFromPath = 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 | ||
72 | type FileProcessor = | 75 | type FileProcessor = |
@@ -163,22 +166,23 @@ type ItemFileProcessor = | |||
163 | 166 | ||
164 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor | 167 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
165 | itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = | 168 | itemFileProcessor 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 | ||
184 | type ThumbnailFileProcessor = | 188 | type 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 | ||
26 | module Resource | 26 | module 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 | ||
101 | type DirProcessor = Path -> IO Path | 101 | type DirProcessor = Path -> IO Path |
102 | type ItemProcessor = Path -> IO Path | 102 | type ItemProcessor = Path -> IO (Path, GalleryItemProps) |
103 | type ThumbnailProcessor = Path -> IO (Maybe Path) | 103 | type 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 |