compiler: implement resource processing

but break directory cleanup

1 files changed, 96 insertions, 0 deletions

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
new file mode 100644
index 0000000..9767394
--- /dev/null
+++ b/compiler/src/Compiler.hs
@@ -0,0 +1,96 @@
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- 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 Compiler
+  ( compileGallery
+  ) where
+
+
+import Control.Monad
+import Data.Function ((&))
+import Data.Ord (comparing)
+import Data.List (sortBy, length)
+import System.Directory (createDirectoryIfMissing, removePathForcibly)
+import System.FilePath (dropFileName, (</>))
+
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as JSON
+
+import Config
+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"
+
+
+compileGallery :: FilePath -> FilePath -> IO ()
+compileGallery inputDirPath outputDirPath =
+  do
+    config <- readConfig (inputDirPath </> "gallery.yaml")
+    inputDir <- readDirectory inputDirPath
+
+    let isGalleryFile = \n -> nodeName n == "gallery.yaml"
+    let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
+
+    inputTree <- readInputTree galleryTree
+
+    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
+
+    putStrLn "\nRESOURCE TREE"
+    putStrLn (show resourceTree)
+
+    --cleanup resourceTree outputDirPath
+
+    buildGalleryTree resourceTree
+      & ensureParentDir JSON.encodeFile (outputDirPath </> "index.json")
+
+    viewer config
+      & 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
+      >>= return . outputDiff resourceTree . root
+      >>= return . sortBy (flip $ comparing length) -- nested files before dirs
+      >>= return . map (localPath . (/>) outputDir)
+      >>= mapM_ remove
+
+    remove :: FileName -> IO ()
+    remove path =
+      do
+        putStrLn $ "Removing: " ++ path
+        removePathForcibly path