diff options
author | Notkea | 2020-02-02 05:31:37 +0100 |
---|---|---|
committer | GitHub | 2020-02-02 05:31:37 +0100 |
commit | a79b9ceb26f385b4e1806ab7f5c4bcaceeeccfd6 (patch) | |
tree | e044161bada71da698849be4be55c26b5949cb3c /compiler/src/Resource.hs | |
parent | b88adf17c2ff40f051b356bcfab006ff3a7fbc97 (diff) | |
parent | 56901340cb510ee9012bb4a122b95831258e9789 (diff) | |
download | ldgallery-a79b9ceb26f385b4e1806ab7f5c4bcaceeeccfd6.tar.gz |
Merge branch 'develop' into oz-viewer
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r-- | compiler/src/Resource.hs | 21 |
1 files changed, 18 insertions, 3 deletions
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 |