From 4fde03c7654dcdad11a8c91ba2bcbb2706695e11 Mon Sep 17 00:00:00 2001 From: pacien Date: Thu, 30 Jan 2020 16:03:54 +0100 Subject: compiler: properly exclude out directory Use canonical paths to exclude the output directory if it is located inside the input directory instead of guessing based on special files. GitHub: closes #54 --- compiler/src/Compiler.hs | 20 +++++++++----------- compiler/src/Files.hs | 49 +++++++++++++++++++++++++++++------------------- 2 files changed, 39 insertions(+), 30 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 . ((>= 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 -- cgit v1.2.3 From d1109852caba5942b037ea6ef998c67bef1d2920 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 31 Jan 2020 18:01:20 +0100 Subject: doc: clarify argument syntax Avoiding silly shell expansion issues for path arguments --- ldgallery.1.md | 6 +++--- readme.md | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) 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/ -- cgit v1.2.3 From b1cdddcca9b627e8ba1f2870aa5e62043f7b04b3 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 31 Jan 2020 18:15:41 +0100 Subject: compiler: auto orient processed images Let ImageMagick re-orient images based on EXIF metadata. Some web browsers still don't support that correctly. GitHub: closes #67 --- compiler/src/Processors.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index f2ade63..df7e632 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -86,7 +86,11 @@ resizePictureUpTo maxResolution inputPath outputPath = maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" resize :: FileName -> FileName -> IO () - resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] + resize input output = callProcess "magick" + [ input + , "-auto-orient" + , "-resize", maxSize maxResolution + , output ] type Cache = FileProcessor -> FileProcessor -- cgit v1.2.3 From 9b947996588c02867541ee394aa84fd3839d5f47 Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 1 Feb 2020 00:00:23 +0100 Subject: compiler: optimise dir diff for output cleanup n log n by sorting instead of silly n^2 GitHub: closes #70 --- compiler/package.yaml | 1 + compiler/src/Resource.hs | 21 ++++++++++++++++++--- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/compiler/package.yaml b/compiler/package.yaml index 9b96d17..1769833 100644 --- a/compiler/package.yaml +++ b/compiler/package.yaml @@ -17,6 +17,7 @@ description: Please see the README on GitHub at = 4.7 && < 5 - containers +- data-ordlist - filepath - directory - text diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index c0ef317..599509e 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -24,8 +24,8 @@ module Resource import Control.Concurrent.ParallelIO.Global (parallel) -import Data.List ((\\), sortBy) -import Data.Ord (comparing) +import Data.List (sortOn) +import Data.List.Ordered (minusBy) import Data.Char (toLower) import Data.Maybe (mapMaybe, fromMaybe, maybeToList) import Data.Function ((&)) @@ -202,11 +202,26 @@ galleryOutputDiff resources ref = thumbnailPaths :: [GalleryItem] -> [Path] thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) + (\\) :: [Path] -> [Path] -> [Path] + a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b) + where + orderedForm :: Path -> WebPath + orderedForm = webPath + + minusOn :: Ord b => (a -> b) -> [a] -> [a] -> [a] + minusOn f l r = map snd $ minusBy comparingFst (packRef f l) (packRef f r) + + packRef :: (a -> b) -> [a] -> [(b, a)] + packRef f = map (\x -> let y = f x in y `seq` (y, x)) + + comparingFst :: Ord b => (b, a) -> (b, a) -> Ordering + comparingFst (l, _) (r, _) = compare l r + galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () galleryCleanupResourceDir resourceTree outputDir = readDirectory outputDir >>= return . galleryOutputDiff resourceTree . root - >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs + >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs >>= return . map (localPath . (/>) outputDir) >>= mapM_ remove -- cgit v1.2.3 From a7b235d8874fe4ad1d7e7a5ce59510d9f55b857d Mon Sep 17 00:00:00 2001 From: Zero~Informatique Date: Sun, 2 Feb 2020 03:11:30 +0100 Subject: viewer: fixed the command button's titles (somehow the `:` were removed before the commit) --- viewer/src/components/LdCommand.vue | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/viewer/src/components/LdCommand.vue b/viewer/src/components/LdCommand.vue index 07cb354..8c6ccfc 100644 --- a/viewer/src/components/LdCommand.vue +++ b/viewer/src/components/LdCommand.vue @@ -19,16 +19,16 @@