aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
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 33f3cf0..400e18a 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 ((&))
@@ -218,11 +218,26 @@ galleryOutputDiff resources ref =
218 . map (resource :: (Thumbnail -> Resource)) 218 . map (resource :: (Thumbnail -> Resource))
219 . mapMaybe thumbnail 219 . mapMaybe thumbnail
220 220
221 (\\) :: [Path] -> [Path] -> [Path]
222 a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b)
223 where
224 orderedForm :: Path -> WebPath
225 orderedForm = webPath
226
227 minusOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
228 minusOn f l r = map snd $ minusBy comparingFst (packRef f l) (packRef f r)
229
230 packRef :: (a -> b) -> [a] -> [(b, a)]
231 packRef f = map (\x -> let y = f x in y `seq` (y, x))
232
233 comparingFst :: Ord b => (b, a) -> (b, a) -> Ordering
234 comparingFst (l, _) (r, _) = compare l r
235
221 236
222galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () 237galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
223galleryCleanupResourceDir resourceTree outputDir = 238galleryCleanupResourceDir resourceTree outputDir =
224 readDirectory outputDir 239 readDirectory outputDir
225 >>= return . galleryOutputDiff resourceTree . root 240 >>= return . galleryOutputDiff resourceTree . root
226 >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs 241 >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs
227 >>= return . map (localPath . (/>) outputDir) 242 >>= return . map (localPath . (/>) outputDir)
228 >>= mapM_ remove 243 >>= mapM_ remove