diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/package.yaml | 1 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 21 |
2 files changed, 19 insertions, 3 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml index 9b96d17..1769833 100644 --- a/compiler/package.yaml +++ b/compiler/package.yaml | |||
@@ -17,6 +17,7 @@ description: Please see the README on GitHub at <https://github.com/paci | |||
17 | dependencies: | 17 | dependencies: |
18 | - base >= 4.7 && < 5 | 18 | - base >= 4.7 && < 5 |
19 | - containers | 19 | - containers |
20 | - data-ordlist | ||
20 | - filepath | 21 | - filepath |
21 | - directory | 22 | - directory |
22 | - text | 23 | - text |
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 |