From abdf82bbfde843a87bd00746f52dafdd28f3f60b Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 5 Jan 2020 15:31:38 +0100 Subject: compiler: make absent file names more explicit --- compiler/src/Compiler.hs | 21 +++++++++++---------- compiler/src/Files.hs | 39 ++++++++++++++++++++------------------- compiler/src/Input.hs | 26 ++++++++++++++++++-------- compiler/src/Processors.hs | 21 +++++++++++---------- compiler/src/Resource.hs | 10 +++++----- 5 files changed, 65 insertions(+), 52 deletions(-) (limited to 'compiler/src') diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 4f2093b..5d30a26 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -20,6 +20,7 @@ DuplicateRecordFields , DeriveGeneric , DeriveAnyClass + , NamedFieldPuns #-} module Compiler @@ -30,7 +31,7 @@ module Compiler import Control.Monad (liftM2) import Data.Function ((&)) import Data.List (any) -import Data.Maybe (isJust) +import Data.Maybe (isJust, fromMaybe) import Text.Regex (Regex, mkRegex, matchRegex) import System.FilePath (()) @@ -80,15 +81,15 @@ galleryDirFilter excludeRegex = (&&&) = liftM2 (&&) (|||) = liftM2 (||) - isConfigFile = (galleryConf ==) . nodeName + matchName :: (FileName -> Bool) -> FSNode -> Bool + matchName cond = maybe False cond . nodeName - isGalleryIndex = (indexFile ==) - isViewerIndex = (viewerMainFile ==) - containsOutputGallery (File _) = False - containsOutputGallery (Dir _ items) = - any ((isGalleryIndex ||| isViewerIndex) . nodeName) items - - excludedName = isJust . matchRegex excludeRegex . nodeName + isConfigFile = matchName (== galleryConf) + isGalleryIndex = matchName (== indexFile) + isViewerIndex = matchName (== viewerMainFile) + containsOutputGallery File{} = False + containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items + excludedName = isJust . matchRegex excludeRegex . fromMaybe "" . nodeName compileGallery :: FilePath -> FilePath -> Bool -> IO () diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index a658ded..53f9c9e 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -25,10 +25,10 @@ module Files ( FileName, LocalPath, WebPath, Path , (), (), (<.>) - , fileName, maybeFileName, subPaths, pathLength + , fileName, subPaths, pathLength , localPath, webPath , FSNode(..), AnchoredFSNode(..) - , nodePath, nodeName, isHidden, flattenDir, filterDir + , nodeName, isHidden, flattenDir, filterDir , readDirectory, copyTo , ensureParentDir, remove, isOutdated ) where @@ -81,12 +81,9 @@ file /> (Path path) = Path (path ++ [file]) (Path (filename:pathto)) <.> ext = Path $ System.FilePath.addExtension filename ext : pathto -fileName :: Path -> FileName -fileName (Path (name:_)) = name - -maybeFileName :: Path -> Maybe FileName -maybeFileName (Path (name:_)) = Just name -maybeFileName _ = Nothing +fileName :: Path -> Maybe FileName +fileName (Path (name:_)) = Just name +fileName _ = Nothing subPaths :: Path -> [Path] subPaths (Path path) = map Path $ subsequences path @@ -101,21 +98,25 @@ webPath :: Path -> WebPath webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path -data FSNode = File Path | Dir Path [FSNode] deriving Show +data FSNode = + File { path :: Path } + | Dir { path :: Path, items :: [FSNode] } + deriving Show + data AnchoredFSNode = AnchoredFSNode { anchor :: LocalPath - , root :: FSNode } deriving Show + , root :: FSNode } + deriving Show -nodePath :: FSNode -> Path -nodePath (File path) = path -nodePath (Dir path _) = path - -nodeName :: FSNode -> FileName -nodeName = fileName . nodePath +nodeName :: FSNode -> Maybe FileName +nodeName = fileName . path isHidden :: FSNode -> Bool -isHidden node = "." `isPrefixOf` filename &&length filename > 1 - where filename = nodeName node +isHidden = hiddenName . nodeName + where + hiddenName :: Maybe FileName -> Bool + hiddenName Nothing = False + hiddenName (Just filename) = "." `isPrefixOf` filename && length filename > 1 -- | DFS with intermediate dirs first. flattenDir :: FSNode -> [FSNode] diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 2e11ebe..7e1b169 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -20,6 +20,7 @@ DuplicateRecordFields , DeriveGeneric , DeriveAnyClass + , NamedFieldPuns #-} module Input @@ -92,7 +93,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root where mkInputNode :: FSNode -> IO (Maybe InputTree) - mkInputNode (File path) | not (sidecarExt `isExtensionOf` (fileName path)) = + mkInputNode file@File{path} | not $ isSidecar file = readSidecarFile (localPath $ anchor /> path <.> sidecarExt) >>= return . InputFile path >>= return . Just @@ -104,10 +105,19 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root mapM mkInputNode items >>= return . catMaybes >>= return . InputDir path (findThumbnail items) - where - findThumbnail :: [FSNode] -> Maybe Path - findThumbnail = (fmap nodePath) . (find matchThumbnail) - matchThumbnail :: FSNode -> Bool - matchThumbnail Dir{} = False - matchThumbnail (File path) = (dropExtension $ fileName path) == "thumbnail" + isSidecar :: FSNode -> Bool + isSidecar Dir{} = False + isSidecar File{path} = + fileName path + & (maybe False $ isExtensionOf sidecarExt) + + isThumbnail :: FSNode -> Bool + isThumbnail Dir{} = False + isThumbnail File{path} = + fileName path + & fmap dropExtension + & (maybe False ("thumbnail" ==)) + + findThumbnail :: [FSNode] -> Maybe Path + findThumbnail = (fmap Files.path) . (find isThumbnail) diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index dab9aaa..2525af4 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -60,16 +60,17 @@ data Format = | Unknown formatFromPath :: Path -> Format -formatFromPath = aux . (map toLower) . takeExtension . fileName +formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName where - aux ".bmp" = Bmp - aux ".jpg" = Jpg - aux ".jpeg" = Jpg - aux ".png" = Png - aux ".tiff" = Tiff - aux ".hdr" = Hdr - aux ".gif" = Gif - aux _ = Unknown + fromExt :: String -> Format + fromExt ".bmp" = Bmp + fromExt ".jpg" = Jpg + fromExt ".jpeg" = Jpg + fromExt ".png" = Png + fromExt ".tiff" = Tiff + fromExt ".hdr" = Hdr + fromExt ".gif" = Gif + fromExt _ = Unknown type FileProcessor = diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index bbabf18..b52522c 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -118,7 +118,7 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i (processedItemPath, properties) <- processItem path processedThumbnail <- processThumbnail path return GalleryItem - { title = optMeta title $ fileName path + { title = optMeta title $ fromMaybe "" $ fileName path , date = optMeta date "" -- TODO: check and normalise dates , description = optMeta description "" , tags = (optMeta tags []) ++ implicitParentTag parent @@ -133,9 +133,9 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i do processedDir <- processDir path processedThumbnail <- maybeThumbnail dirThumbnailPath - processedItems <- parallel $ map (mkGalleryItem $ maybeFileName path) items + processedItems <- parallel $ map (mkGalleryItem $ fileName path) items return GalleryItem - { title = fileName path + { title = fromMaybe "" $ fileName path -- TODO: consider using the most recent item's date? what if empty? , date = "" -- TODO: consider allowing metadata sidecars for directories too @@ -177,7 +177,7 @@ galleryOutputDiff resources ref = thumbnailPaths = (concatMap subPaths) . (mapMaybe thumbnail) fsPaths :: FSNode -> [Path] - fsPaths = map nodePath . tail . flattenDir + fsPaths = map Files.path . tail . flattenDir galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () -- cgit v1.2.3