From 1e57d76eadb2192be2b3d9343d4ddfeccc996bcb Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 13:38:47 +0100
Subject: compiler: exclude output dir from input

---
 compiler/app/Main.hs     | 21 ++++++++++++-----
 compiler/src/Compiler.hs | 59 ++++++++++++++++++++++++++++--------------------
 2 files changed, 50 insertions(+), 30 deletions(-)

(limited to 'compiler')

diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs
index be57c82..d9b019a 100644
--- a/compiler/app/Main.hs
+++ b/compiler/app/Main.hs
@@ -29,29 +29,38 @@ import Compiler
 
 data Args = Args
   { inputDir :: String
-  , outputDir :: String }
+  , outputDir :: String
+  , rebuild :: Bool }
 
 args :: Parser Args
 args = Args
   <$> strOption
      ( long "input"
     <> short 'i'
-    <> metavar "INPUT DIR"
+    <> metavar "SOURCE DIR"
+    <> value "./"
+    <> showDefault
     <> help "Gallery source directory" )
   <*> strOption
      ( long "output"
     <> short 'o'
     <> metavar "OUTPUT DIR"
-    <> help "Generated gallery output path, outside of the input directory" )
+    <> value "./out"
+    <> showDefault
+    <> help "Generated gallery output path" )
+  <*> switch
+     ( long "rebuild"
+    <> short 'r'
+    <> help "Invalidate cache and recompile everything" )
 
 main :: IO ()
 main =
   do
     options <- execParser opts
-    compileGallery (inputDir options) (outputDir options)
+    compileGallery (inputDir options) (outputDir options) (rebuild options)
 
   where
     opts = info (args <**> helper)
        ( fullDesc
-      <> progDesc "Compile a picture gallery"
-      <> header "ldgallery - A static generator which turns a collection of tagged pictures into a searchable web gallery.")
+      <> progDesc "Compile a gallery"
+      <> header "ldgallery - a static gallery generator with tags" )
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 854fd03..2584570 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -27,31 +27,33 @@ module Compiler
   ) where
 
 
-import Control.Monad
+import Control.Monad (liftM2)
 import Data.Function ((&))
+import Data.List (any)
 import System.FilePath ((</>))
 
 import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
 
 import Config
+import Input (decodeYamlFile, readInputTree)
+import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
+import Gallery (buildGalleryTree)
 import Files
   ( FileName
+  , FSNode(..)
   , readDirectory
-  , localPath
   , isHidden
   , nodeName
   , filterDir
-  , flattenDir
-  , root
-  , (/>)
   , ensureParentDir
   , isOutdated )
-
-import Input (decodeYamlFile, readInputTree)
-import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
-import Gallery (buildGalleryTree)
 import Processors
+  ( dirFileProcessor
+  , itemFileProcessor
+  , thumbnailFileProcessor
+  , skipCached
+  , withCached )
 
 
 writeJSON :: ToJSON a => FileName -> a -> IO ()
@@ -61,26 +63,21 @@ writeJSON outputPath object =
     ensureParentDir JSON.encodeFile outputPath object
 
 
-compileGallery :: FilePath -> FilePath -> IO ()
-compileGallery inputDirPath outputDirPath =
+compileGallery :: FilePath -> FilePath -> Bool -> IO ()
+compileGallery inputDirPath outputDirPath rebuildAll =
   do
     fullConfig <- readConfig inputGalleryConf
     let config = compiler fullConfig
 
-    -- TODO: exclude output dir if it's under the input dir
     inputDir <- readDirectory inputDirPath
-
-    let isGalleryFile = \n -> nodeName n == galleryConf
-    let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
-
-    inputTree <- readInputTree galleryTree
+    let sourceTree = filterDir galleryDirFilter inputDir
+    inputTree <- readInputTree sourceTree
 
     invalidateCache <- isOutdated inputGalleryConf outputIndex
-    let cache = if invalidateCache then skipCached else withCached
-    let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
-    let itemProc = itemFileProcessor (pictureMaxResolution config) cache inputDirPath outputDirPath itemsDir
-    let thumbnailProc = thumbnailFileProcessor (thumbnailResolution config) cache inputDirPath outputDirPath thumbnailsDir
-    resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
+    let cache = if invalidateCache || rebuildAll then skipCached else withCached
+    let itemProc = itemProcessor (pictureMaxResolution config) cache
+    let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
+    resourceTree <- buildResourceTree dirProcessor itemProc thumbnailProc inputTree
 
     cleanupResourceDir resourceTree outputDirPath
 
@@ -92,9 +89,23 @@ compileGallery inputDirPath outputDirPath =
 
   where
     galleryConf = "gallery.yaml"
+    indexFile = "index.json"
+    viewerConfFile = "viewer.json"
     itemsDir = "items"
     thumbnailsDir = "thumbnails"
 
     inputGalleryConf = inputDirPath </> galleryConf
-    outputIndex = outputDirPath </> "index.json"
-    outputViewerConf = outputDirPath </> "viewer.json"
+    outputIndex = outputDirPath </> indexFile
+    outputViewerConf = outputDirPath </> viewerConfFile
+
+    (&&&) = liftM2 (&&)
+    galleryDirFilter = (not . containsOutputGallery) &&& (not . isConfigFile) &&& (not . isHidden)
+    isConfigFile = (==) galleryConf . nodeName
+    containsOutputGallery (File _) = False
+    containsOutputGallery (Dir _ items) = any ((==) indexFile . nodeName) items
+
+    dirProcessor = dirFileProcessor inputDirPath outputDirPath itemsDir
+    itemProcessor maxRes cache =
+      itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
+    thumbnailProcessor thumbRes cache =
+      thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir
-- 
cgit v1.2.3