diff options
Diffstat (limited to 'compiler/src/Processors.hs')
-rw-r--r-- | compiler/src/Processors.hs | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index b1b688a..02db325 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -138,6 +138,17 @@ getImageResolution fsPath = | |||
138 | (Just w, Just h) -> return $ Resolution w h | 138 | (Just w, Just h) -> return $ Resolution w h |
139 | _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." | 139 | _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." |
140 | 140 | ||
141 | getPictureProps :: ItemDescriber | ||
142 | getPictureProps fsPath resource = | ||
143 | getImageResolution fsPath | ||
144 | >>= return . Picture resource | ||
145 | |||
146 | |||
147 | type ItemDescriber = | ||
148 | FilePath | ||
149 | -> Resource | ||
150 | -> IO GalleryItemProps | ||
151 | |||
141 | 152 | ||
142 | type ItemFileProcessor = | 153 | type ItemFileProcessor = |
143 | FileName -- ^ Input base path | 154 | FileName -- ^ Input base path |
@@ -147,19 +158,20 @@ type ItemFileProcessor = | |||
147 | 158 | ||
148 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor | 159 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
149 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = | 160 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = |
150 | cached processor inPath outPath | 161 | cached processor inPath outPath |
151 | >> resourceAt outPath relOutPath | 162 | >> resourceAt outPath relOutPath |
152 | >>= return . props | 163 | >>= descriptor outPath |
153 | where | 164 | where |
154 | relOutPath = resClass /> inputRes | 165 | relOutPath = resClass /> inputRes |
155 | inPath = localPath $ inputBase /> inputRes | 166 | inPath = localPath $ inputBase /> inputRes |
156 | outPath = localPath $ outputBase /> relOutPath | 167 | outPath = localPath $ outputBase /> relOutPath |
157 | (processor, props) = processorFor maxResolution $ formatFromPath inputRes | 168 | (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution |
158 | 169 | ||
159 | processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps) | 170 | processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) |
160 | processorFor (Just maxRes) PictureFormat = (resizePictureUpTo maxRes, Picture) | 171 | processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) |
161 | processorFor Nothing PictureFormat = (copyFileProcessor, Picture) | 172 | processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) |
162 | processorFor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others? | 173 | -- TODO: handle video reencoding and others? |
174 | processorFor Unknown _ = (copyFileProcessor, const $ return . Other) | ||
163 | 175 | ||
164 | 176 | ||
165 | type ThumbnailFileProcessor = | 177 | type ThumbnailFileProcessor = |