diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Processors.hs | 6 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 21 |
2 files changed, 23 insertions, 4 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index f2ade63..df7e632 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -86,7 +86,11 @@ resizePictureUpTo maxResolution inputPath outputPath = | |||
86 | maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" | 86 | maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" |
87 | 87 | ||
88 | resize :: FileName -> FileName -> IO () | 88 | resize :: FileName -> FileName -> IO () |
89 | resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] | 89 | resize input output = callProcess "magick" |
90 | [ input | ||
91 | , "-auto-orient" | ||
92 | , "-resize", maxSize maxResolution | ||
93 | , output ] | ||
90 | 94 | ||
91 | 95 | ||
92 | type Cache = FileProcessor -> FileProcessor | 96 | type Cache = FileProcessor -> FileProcessor |
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index c0ef317..599509e 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs | |||
@@ -24,8 +24,8 @@ module Resource | |||
24 | 24 | ||
25 | 25 | ||
26 | import Control.Concurrent.ParallelIO.Global (parallel) | 26 | import Control.Concurrent.ParallelIO.Global (parallel) |
27 | import Data.List ((\\), sortBy) | 27 | import Data.List (sortOn) |
28 | import Data.Ord (comparing) | 28 | import Data.List.Ordered (minusBy) |
29 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) | 30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) |
31 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
@@ -202,11 +202,26 @@ galleryOutputDiff resources ref = | |||
202 | thumbnailPaths :: [GalleryItem] -> [Path] | 202 | thumbnailPaths :: [GalleryItem] -> [Path] |
203 | thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) | 203 | thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) |
204 | 204 | ||
205 | (\\) :: [Path] -> [Path] -> [Path] | ||
206 | a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b) | ||
207 | where | ||
208 | orderedForm :: Path -> WebPath | ||
209 | orderedForm = webPath | ||
210 | |||
211 | minusOn :: Ord b => (a -> b) -> [a] -> [a] -> [a] | ||
212 | minusOn f l r = map snd $ minusBy comparingFst (packRef f l) (packRef f r) | ||
213 | |||
214 | packRef :: (a -> b) -> [a] -> [(b, a)] | ||
215 | packRef f = map (\x -> let y = f x in y `seq` (y, x)) | ||
216 | |||
217 | comparingFst :: Ord b => (b, a) -> (b, a) -> Ordering | ||
218 | comparingFst (l, _) (r, _) = compare l r | ||
219 | |||
205 | 220 | ||
206 | galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () | 221 | galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () |
207 | galleryCleanupResourceDir resourceTree outputDir = | 222 | galleryCleanupResourceDir resourceTree outputDir = |
208 | readDirectory outputDir | 223 | readDirectory outputDir |
209 | >>= return . galleryOutputDiff resourceTree . root | 224 | >>= return . galleryOutputDiff resourceTree . root |
210 | >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs | 225 | >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs |
211 | >>= return . map (localPath . (/>) outputDir) | 226 | >>= return . map (localPath . (/>) outputDir) |
212 | >>= mapM_ remove | 227 | >>= mapM_ remove |