aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
authorNotkea2020-02-02 05:31:37 +0100
committerGitHub2020-02-02 05:31:37 +0100
commita79b9ceb26f385b4e1806ab7f5c4bcaceeeccfd6 (patch)
treee044161bada71da698849be4be55c26b5949cb3c /compiler/src/Resource.hs
parentb88adf17c2ff40f051b356bcfab006ff3a7fbc97 (diff)
parent56901340cb510ee9012bb4a122b95831258e9789 (diff)
downloadldgallery-a79b9ceb26f385b4e1806ab7f5c4bcaceeeccfd6.tar.gz
Merge branch 'develop' into oz-viewer
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs21
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
26import Control.Concurrent.ParallelIO.Global (parallel) 26import Control.Concurrent.ParallelIO.Global (parallel)
27import Data.List ((\\), sortBy) 27import Data.List (sortOn)
28import Data.Ord (comparing) 28import Data.List.Ordered (minusBy)
29import Data.Char (toLower) 29import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe, maybeToList) 30import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
31import Data.Function ((&)) 31import 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
206galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () 221galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
207galleryCleanupResourceDir resourceTree outputDir = 222galleryCleanupResourceDir 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