compiler: implement resource processing

but break directory cleanup

7 files changed, 341 insertions, 75 deletions

diff --git a/compiler/src/Lib.hs b/compiler/src/Compiler.hs
index b2bbe15..9767394 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Compiler.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
-
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
@@ -18,12 +16,18 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
+{-# LANGUAGE
+    DuplicateRecordFields
+  , DeriveGeneric
+  , DeriveAnyClass
+#-}
 
-module Lib
-  ( testRun
+module Compiler
+  ( compileGallery
   ) where
 
 
+import Control.Monad
 import Data.Function ((&))
 import Data.Ord (comparing)
 import Data.List (sortBy, length)
@@ -34,42 +38,49 @@ import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
 
 import Config
-import Files (FileName, readDirectory, localPath, flattenDir, root, (/>))
+import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
 import Input (decodeYamlFile, readInputTree)
 import Resource (ResourceTree, buildResourceTree, outputDiff)
 import Gallery (buildGalleryTree)
+import Processors
+
+
+itemsDir :: String
+itemsDir = "items"
 
+thumbnailsDir :: String
+thumbnailsDir = "thumbnails"
 
-process :: FilePath -> FilePath -> IO ()
-process inputDirPath outputDirPath =
+
+compileGallery :: FilePath -> FilePath -> IO ()
+compileGallery inputDirPath outputDirPath =
   do
     config <- readConfig (inputDirPath </> "gallery.yaml")
     inputDir <- readDirectory inputDirPath
-    inputTree <- readInputTree inputDir
 
-    let resourceTree = buildResourceTree inputTree
-    putStrLn "\nRESOURCE TREE"
-    putStrLn (show resourceTree)
+    let isGalleryFile = \n -> nodeName n == "gallery.yaml"
+    let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
 
-    -- TODO: make buildResourceTree build a resource compilation strategy
-    -- (need to know the settings)
-    -- flatten the tree of resources and their strategies
-    -- filter resources that are already up to date
-    --   (or recompile everything if the config file has changed!)
-    -- execute in parallel
+    inputTree <- readInputTree galleryTree
 
-    -- TODO: execute (in parallel) the resource compilation strategy list
-    -- need to find a good library for that
+    let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
+    let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir
+    let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir
+    resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
 
-    cleanup resourceTree outputDirPath
+    putStrLn "\nRESOURCE TREE"
+    putStrLn (show resourceTree)
+
+    --cleanup resourceTree outputDirPath
 
     buildGalleryTree resourceTree
-      & writeJSON (outputDirPath </> "index.json")
+      & ensureParentDir JSON.encodeFile (outputDirPath </> "index.json")
 
     viewer config
-      & writeJSON (outputDirPath </> "viewer.json")
+      & ensureParentDir JSON.encodeFile (outputDirPath </> "viewer.json")
 
   where
+    -- TODO: delete all files, then only non-empty dirs
     cleanup :: ResourceTree -> FileName -> IO ()
     cleanup resourceTree outputDir =
       readDirectory outputDir
@@ -83,12 +94,3 @@ process inputDirPath outputDirPath =
       do
         putStrLn $ "Removing: " ++ path
         removePathForcibly path
-
-    writeJSON :: ToJSON a => FileName -> a -> IO ()
-    writeJSON path obj =
-      createDirectoryIfMissing True (dropFileName path)
-      >> JSON.encodeFile path obj
-
-
-testRun :: IO ()
-testRun = process "../../example" "../../out"
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 6f04818..f147bdd 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
-
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
@@ -18,6 +16,11 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
+{-# LANGUAGE
+    DuplicateRecordFields
+  , DeriveGeneric
+  , DeriveAnyClass
+#-}
 
 module Config
   ( GalleryConfig(..)
@@ -25,6 +28,7 @@ module Config
   , readConfig
   ) where
 
+
 import GHC.Generics (Generic)
 import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 77a8c5b..0392efe 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
-
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
@@ -18,12 +16,17 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
+{-# LANGUAGE
+    DuplicateRecordFields
+  , DeriveGeneric
+#-}
 
 module Files
   ( FileName, LocalPath, WebPath, Path
   , (</>), (</), (/>), localPath, webPath
   , FSNode(..), AnchoredFSNode(..)
   , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
+  , ensureParentDir
   ) where
 
 
@@ -31,7 +34,7 @@ import Control.Monad (filterM, mapM)
 import Data.Bool (bool)
 import Data.List (isPrefixOf, length, deleteBy)
 import Data.Function ((&))
-import System.Directory (doesDirectoryExist, listDirectory)
+import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing)
 
 import qualified System.FilePath
 import qualified System.FilePath.Posix
@@ -79,13 +82,17 @@ isHidden node = "." `isPrefixOf` filename && length filename > 1
 -- | DFS with intermediate dirs first.
 flattenDir :: FSNode -> [FSNode]
 flattenDir file@(File _) = [file]
-flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs)
+flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
 
 -- | Filters a dir tree. The root is always returned.
-filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
-filterDir _ file@(File _) = file
-filterDir cond (Dir path childs) =
-  filter cond childs & map (filterDir cond) & Dir path
+filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
+filterDir cond (AnchoredFSNode anchor root) =
+  AnchoredFSNode anchor (filterNode root)
+  where
+  filterNode :: FSNode -> FSNode
+  filterNode file@(File _) = file
+  filterNode (Dir path items) =
+    filter cond items & map filterNode & Dir path
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
 readDirectory root = mkNode [] >>= return . AnchoredFSNode root
@@ -103,3 +110,11 @@ readDirectory root = mkNode [] >>= return . AnchoredFSNode root
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
       >>= return . Dir path
+
+
+ensureParentDir :: (FileName -&