From 015d793b25a3f0d1ff275ed42ec211dd6a532ca0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:21:44 +0100
Subject: compiler: fix old resources cleanup

---
 compiler/src/Compiler.hs | 13 +++++++++----
 compiler/src/Resource.hs | 10 +++++++---
 2 files changed, 16 insertions(+), 7 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 9767394..991de9c 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -71,16 +71,15 @@ compileGallery inputDirPath outputDirPath =
     putStrLn "\nRESOURCE TREE"
     putStrLn (show resourceTree)
 
-    --cleanup resourceTree outputDirPath
+    cleanup resourceTree outputDirPath
 
     buildGalleryTree resourceTree
-      & ensureParentDir JSON.encodeFile (outputDirPath </> "index.json")
+      & writeJSON (outputDirPath </> "index.json")
 
     viewer config
-      & ensureParentDir JSON.encodeFile (outputDirPath </> "viewer.json")
+      & writeJSON (outputDirPath </> "viewer.json")
 
   where
-    -- TODO: delete all files, then only non-empty dirs
     cleanup :: ResourceTree -> FileName -> IO ()
     cleanup resourceTree outputDir =
       readDirectory outputDir
@@ -94,3 +93,9 @@ compileGallery inputDirPath outputDirPath =
       do
         putStrLn $ "Removing: " ++ path
         removePathForcibly path
+
+    writeJSON :: ToJSON a => FileName -> a -> IO ()
+    writeJSON outputPath object =
+      do
+        putStrLn $ "Generating: " ++ outputPath
+        ensureParentDir JSON.encodeFile outputPath object
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index dc849cd..83f7438 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -34,7 +34,7 @@ module Resource
 
 
 import Data.Function ((&))
-import Data.List ((\\))
+import Data.List ((\\), subsequences)
 import Data.Maybe (mapMaybe)
 import Files
 import Input (InputTree(..), Sidecar)
@@ -93,10 +93,14 @@ flattenResourceTree dir@(DirResource items _ _) =
   dir:(concatMap flattenResourceTree items)
 
 outputDiff :: ResourceTree -> FSNode -> [Path]
-outputDiff resources ref = (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
+outputDiff resources ref =
+  (fsPaths ref) \\ (resPaths $ flattenResourceTree resources)
   where
     resPaths :: [ResourceTree] -> [Path]
-    resPaths resList = (map resPath resList) ++ (mapMaybe thumbnailPath resList)
+    resPaths resList = map resPath resList ++ thumbnailPaths resList
+
+    thumbnailPaths :: [ResourceTree] -> [Path]
+    thumbnailPaths = (concatMap subsequences) . (mapMaybe thumbnailPath)
 
     fsPaths :: FSNode -> [Path]
     fsPaths = map nodePath . tail . flattenDir
-- 
cgit v1.2.3