From 00c6216259d8a7b131307953ba5000d2b5dc564b Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 00:06:18 +0200 Subject: compiler: trivial code simplifications Following HLint's advice. --- compiler/src/Input.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'compiler/src/Input.hs') diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 6ed7471..1316cdd 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs @@ -27,6 +27,7 @@ import GHC.Generics (Generic) import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Function ((&)) +import Data.Functor ((<&>)) import Data.Maybe (catMaybes) import Data.Bool (bool) import Data.List (find) @@ -90,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar readSidecarFile filepath = doesFileExist filepath >>= bool (return Nothing) (decodeYamlFile filepath) - >>= return . maybe emptySidecar id + <&> maybe emptySidecar id readInputTree :: AnchoredFSNode -> IO InputTree @@ -100,13 +101,13 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root where mkInputNode :: FSNode -> IO (Maybe InputTree) mkInputNode file@File{path} - | (not $ isSidecar file) && (not $ isThumbnail file) = + | not (isSidecar file) && not (isThumbnail file) = do sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt) modTime <- getModificationTime $ localPath (anchor /> path) return $ Just $ InputFile path modTime sidecar mkInputNode File{} = return Nothing - mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just + mkInputNode dir@Dir{} = Just <$> mkDirNode dir mkDirNode :: FSNode -> IO InputTree mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" @@ -121,17 +122,17 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root isSidecar Dir{} = False isSidecar File{path} = fileName path - & (maybe False $ isExtensionOf sidecarExt) + & maybe False (isExtensionOf sidecarExt) isThumbnail :: FSNode -> Bool isThumbnail Dir{} = False isThumbnail File{path} = fileName path & fmap dropExtension - & (maybe False (dirPropFile ==)) + & maybe False (dirPropFile ==) findThumbnail :: [FSNode] -> Maybe Path - findThumbnail = (fmap Files.path) . (find isThumbnail) + findThumbnail = fmap Files.path . find isThumbnail -- | Filters an InputTree. The root is always returned. filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree -- cgit v1.2.3 From 52abb806a3bde6eb69d64564d971efae2cbfda24 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 15 Jun 2020 04:46:11 +0200 Subject: compiler: reuse derived item properties from last compilation A benchmark on an already bulit gallery with ~600 pictures shows a ~90% speedup: Before: Time (mean ± σ): 2.879 s ± 0.125 s [User: 14.686 s, System: 5.511 s] Range (min … max): 2.774 s … 3.203 s 10 runs After: Time (mean ± σ): 289.5 ms ± 15.1 ms [User: 596.1 ms, System: 359.3 ms] Range (min … max): 272.8 ms … 323.0 ms 10 runs GitHub: closes #97 --- compiler/src/Input.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'compiler/src/Input.hs') diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 1316cdd..2480f5b 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs @@ -28,7 +28,7 @@ import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Function ((&)) import Data.Functor ((<&>)) -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, fromMaybe) import Data.Bool (bool) import Data.List (find) import Data.Time.Clock (UTCTime) @@ -91,7 +91,7 @@ readSidecarFile :: FilePath -> IO Sidecar readSidecarFile filepath = doesFileExist filepath >>= bool (return Nothing) (decodeYamlFile filepath) - <&> maybe emptySidecar id + <&> fromMaybe emptySidecar readInputTree :: AnchoredFSNode -> IO InputTree -- cgit v1.2.3 From e27f9a220fd8597266d52934bcb06dbe1681b338 Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 16 Jun 2020 23:30:32 +0200 Subject: compiler: allow setting thumbnails for all items Not only for directories. GitHub: closes #224 --- compiler/src/Input.hs | 60 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 37 insertions(+), 23 deletions(-) (limited to 'compiler/src/Input.hs') diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 2480f5b..48931ec 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs @@ -30,11 +30,12 @@ import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Maybe (catMaybes, fromMaybe) import Data.Bool (bool) -import Data.List (find) +import Data.List (find, isSuffixOf) import Data.Time.Clock (UTCTime) import Data.Time.LocalTime (ZonedTime) import Data.Yaml (ParseException, decodeFileEither) import Data.Aeson (FromJSON) +import qualified Data.Map.Strict as Map import System.FilePath (isExtensionOf, dropExtension) import System.Directory (doesFileExist, getModificationTime) @@ -55,12 +56,13 @@ data InputTree = InputFile { path :: Path , modTime :: UTCTime - , sidecar :: Sidecar } + , sidecar :: Sidecar + , thumbnailPath :: Maybe Path } | InputDir { path :: Path , modTime :: UTCTime , sidecar :: Sidecar - , dirThumbnailPath :: Maybe Path + , thumbnailPath :: Maybe Path , items :: [InputTree] } deriving Show @@ -81,6 +83,9 @@ emptySidecar = Sidecar sidecarExt :: String sidecarExt = "yaml" +thumbnailSuffix :: String +thumbnailSuffix = "_thumbnail" + dirPropFile :: String dirPropFile = "_directory" @@ -99,40 +104,49 @@ readInputTree (AnchoredFSNode _ File{}) = throw $ AssertionFailed "Input directory is a file" readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root where - mkInputNode :: FSNode -> IO (Maybe InputTree) - mkInputNode file@File{path} - | not (isSidecar file) && not (isThumbnail file) = - do - sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt) - modTime <- getModificationTime $ localPath (anchor /> path) - return $ Just $ InputFile path modTime sidecar - mkInputNode File{} = return Nothing - mkInputNode dir@Dir{} = Just <$> mkDirNode dir + mkInputNode :: Map.Map FileName FSNode -> FSNode -> IO (Maybe InputTree) + mkInputNode dir file@File{path} | not (isSidecar file) && not (isThumbnail file) = + do + sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt) + modTime <- getModificationTime $ localPath (anchor /> path) + let thumbnail = findFileThumbnail (fromMaybe "" $ fileName path) dir + return $ Just $ InputFile path modTime sidecar thumbnail + mkInputNode _ File{} = return Nothing + mkInputNode _ dir@Dir{} = Just <$> mkDirNode dir mkDirNode :: FSNode -> IO InputTree mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" mkDirNode Dir{path, items} = do - dirItems <- mapM mkInputNode items + dirItems <- mapM (mkInputNode $ Map.fromList (map withBaseName items)) items modTime <- getModificationTime $ localPath (anchor /> path) sidecar <- readSidecarFile $ localPath (anchor /> path dirSidecar) - return $ InputDir path modTime sidecar (findThumbnail items) (catMaybes dirItems) + return $ InputDir path modTime sidecar (findDirThumbnail items) (catMaybes dirItems) + + withBaseName :: FSNode -> (FileName, FSNode) + withBaseName node = (fromMaybe "" $ baseName $ Files.path node, node) + + findFileThumbnail :: FileName -> Map.Map FileName FSNode -> Maybe Path + findFileThumbnail name dict = Files.path <$> Map.lookup (name ++ thumbnailSuffix) dict isSidecar :: FSNode -> Bool isSidecar Dir{} = False - isSidecar File{path} = - fileName path - & maybe False (isExtensionOf sidecarExt) + isSidecar File{path} = fileName path & maybe False (isExtensionOf sidecarExt) + + baseName :: Path -> Maybe FileName + baseName = fmap dropExtension . fileName isThumbnail :: FSNode -> Bool isThumbnail Dir{} = False - isThumbnail File{path} = - fileName path - & fmap dropExtension - & maybe False (dirPropFile ==) + isThumbnail File{path} = baseName path & maybe False (thumbnailSuffix `isSuffixOf`) + + isDirThumbnail :: FSNode -> Bool + isDirThumbnail Dir{} = False + isDirThumbnail File{path} = baseName path & (== Just thumbnailSuffix) + + findDirThumbnail :: [FSNode] -> Maybe Path + findDirThumbnail = fmap Files.path . find isDirThumbnail - findThumbnail :: [FSNode] -> Maybe Path - findThumbnail = fmap Files.path . find isThumbnail -- | Filters an InputTree. The root is always returned. filterInputTree :: (InputTree -> Bool) -> InputTree -> InputTree -- cgit v1.2.3