Merge pull request #72 from pacien/fix-implicit-output-exclusion

Fix implicit output exclusion

4 files changed, 43 insertions, 34 deletions

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 8819ffc..d392f74 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -26,6 +26,7 @@ import Control.Monad (liftM2)
 import Data.List (any)
 import System.FilePath ((</>))
 import qualified System.FilePath.Glob as Glob
+import System.Directory (canonicalizePath)
 
 import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
@@ -52,9 +53,6 @@ galleryConf = "gallery.yaml"
 indexFile :: String
 indexFile = "index.json"
 
-viewerMainFile :: String
-viewerMainFile = "index.html"
-
 viewerConfFile :: String
 viewerConfFile = "viewer.json"
 
@@ -72,11 +70,11 @@ writeJSON outputPath object =
     ensureParentDir JSON.encodeFile outputPath object
 
 
-galleryDirFilter :: CompilerConfig -> FSNode -> Bool
-galleryDirFilter config =
+galleryDirFilter :: CompilerConfig -> FilePath -> FSNode -> Bool
+galleryDirFilter config outputDir =
       (not . isHidden)
+  &&& (not . isOutputGallery)
   &&& (not . matchesFile (== galleryConf))
-  &&& (not . containsOutputGallery)
   &&& ((matchesDir $ anyPattern $ includedDirectories config) |||
        (matchesFile $ anyPattern $ includedFiles config))
   &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) |||
@@ -97,10 +95,9 @@ galleryDirFilter config =
     anyPattern :: [String] -> FileName -> Bool
     anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns)
 
-    containsOutputGallery :: FSNode -> Bool
-    containsOutputGallery File{} = False
-    containsOutputGallery Dir{items} =
-      any (matchesFile (== indexFile) ||| matchesFile (== viewerMainFile)) items
+    isOutputGallery :: FSNode -> Bool
+    isOutputGallery Dir{canonicalPath} = canonicalPath == outputDir
+    isOutputGallery File{} = False
 
 
 compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO ()
@@ -110,7 +107,8 @@ compileGallery inputDirPath outputDirPath rebuildAll cleanOutput =
     let config = compiler fullConfig
 
     inputDir <- readDirectory inputDirPath
-    let sourceFilter = galleryDirFilter config
+    canonicalOutPath <- canonicalizePath outputDirPath
+    let sourceFilter = galleryDirFilter config canonicalOutPath
     let sourceTree = filterDir sourceFilter inputDir
     inputTree <- readInputTree sourceTree
 
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 41fc5a8..8ea943f 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -29,7 +29,6 @@ module Files
 
 
 import Control.Monad (mapM)
-import Data.Bool (bool)
 import Data.List (isPrefixOf, length, subsequences)
 import Data.Function ((&))
 import Data.Text (pack)
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON
 import System.Directory
   ( doesDirectoryExist
   , doesPathExist
+  , canonicalizePath
   , getModificationTime
   , listDirectory
   , createDirectoryIfMissing
@@ -94,8 +94,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
 
 
 data FSNode =
-    File { path :: Path }
-  | Dir { path :: Path, items :: [FSNode] }
+    File
+      { path :: Path
+      , canonicalPath :: FilePath }
+  | Dir
+      { path :: Path
+      , canonicalPath :: FilePath
+      , items :: [FSNode] }
   deriving Show
 
 data AnchoredFSNode = AnchoredFSNode
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName
 
 -- | DFS with intermediate dirs first.
 flattenDir :: FSNode -> [FSNode]
-flattenDir file@(File _) = [file]
-flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
+flattenDir file@File{} = [file]
+flattenDir dir@Dir{items} = dir:(concatMap flattenDir items)
 
 -- | Filters a dir tree. The root is always returned.
 filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -124,35 +129,41 @@ 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
+  filterNode file@File{} = file
+  filterNode Dir{path, canonicalPath, items} =
+    filter cond items & map filterNode & Dir path canonicalPath
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
 readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
   where
     mkNode :: Path -> IO FSNode
     mkNode path =
-      (doesDirectoryExist $ localPath (root /> path))
-      >>= bool (mkFileNode path) (mkDirNode path)
-
-    mkFileNode :: Path -> IO FSNode
-    mkFileNode path = return $ File path
-
-    mkDirNode :: Path -> IO FSNode
-    mkDirNode path =
+      do
+        let relPath = localPath (root /> path)
+        canonicalPath <- canonicalizePath relPath
+        isDir <- doesDirectoryExist relPath
+        if isDir then
+          mkDirNode path canonicalPath
+        else
+          mkFileNode path canonicalPath
+
+    mkFileNode :: Path -> FilePath -> IO FSNode
+    mkFileNode path canonicalPath = return $ File path canonicalPath
+
+    mkDirNode :: Path -> FilePath -> IO FSNode
+    mkDirNode path canonicalPath =
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
-      >>= return . Dir path
+      >>= return . Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
 copyTo target AnchoredFSNode{anchor, root} = copyNode root
   where
     copyNode :: FSNode -> IO ()
-    copyNode (File path) =
+    copyNode File{path} =
       copyFile (localPath $ anchor /> path) (localPath $ target /> path)
 
-    copyNode (Dir path items) =
+    copyNode Dir{path, items} =
       createDirectoryIfMissing True (localPath $ target /> path)
       >> mapM_ copyNode items
 
diff --git a/ldgallery.1.md b/ldgallery.1.md
index c40a4ce..8784fb2 100644
--- a/ldgallery.1.md
+++ b/ldgallery.1.md
@@ -20,14 +20,14 @@ The ldgallery compiler program processes pictures and aggregates metadata from p
 
 # COMMAND
 
-ldgallery [\--input-dir=_./_] [\--output-dir=_./out_] [\--with-viewer]
+ldgallery [\--input-dir _./_] [\--output-dir _./out_] [\--with-viewer]
 
 Available options are:
 
--i, \--input-dir=_DIR_
+-i, \--input-dir _DIR_
 : Gallery source directory.  Defaults to the current directory.
 
--o, \--output-dir=_DIR_
+-o, \--output-dir _DIR_
 : Generated gallery output path.  Defaults to ./out.
 
 -r, \--rebuild-all
diff --git a/readme.md b/readme.md
index e7a3902..2ceb248 100644
--- a/readme.md
+++ b/readme.md
@@ -17,7 +17,7 @@ Build
 The man page can be generated using [Pandoc]:
 
 ```
-pandoc --standalone --to man ldgallery.1.md --output=ldgallery.1
+pandoc --standalone --to man ldgallery.1.md --output ldgallery.1
 ```
 
 [Pandoc]: https://pandoc.org/