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/Compiler.hs | 18 +++++++++--------- compiler/src/Config.hs | 4 ++-- compiler/src/Files.hs | 15 ++++++++------- compiler/src/Input.hs | 13 +++++++------ compiler/src/Processors.hs | 15 +++++---------- compiler/src/Resource.hs | 16 ++++++++-------- 6 files changed, 39 insertions(+), 42 deletions(-) (limited to 'compiler/src') diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 749872d..2bb27f9 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs @@ -81,16 +81,16 @@ writeJSON outputPath object = (|||) = liftM2 (||) anyPattern :: [String] -> String -> Bool -anyPattern patterns string = any (flip Glob.match string) (map Glob.compile patterns) +anyPattern patterns string = any (flip Glob.match string . Glob.compile) patterns galleryDirFilter :: GalleryConfig -> [FilePath] -> FSNode -> Bool galleryDirFilter config excludedCanonicalDirs = (not . isHidden) &&& (not . isExcludedDir) - &&& ((matchesDir $ anyPattern $ includedDirectories config) ||| - (matchesFile $ anyPattern $ includedFiles config)) - &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) ||| - (matchesFile $ anyPattern $ excludedFiles config))) + &&& (matchesDir (anyPattern $ includedDirectories config) ||| + matchesFile (anyPattern $ includedFiles config)) + &&& (not . (matchesDir (anyPattern $ excludedDirectories config) ||| + matchesFile (anyPattern $ excludedFiles config))) where matchesDir :: (FileName -> Bool) -> FSNode -> Bool @@ -102,17 +102,17 @@ galleryDirFilter config excludedCanonicalDirs = matchesFile _ Dir{} = False isExcludedDir :: FSNode -> Bool - isExcludedDir Dir{canonicalPath} = any (canonicalPath ==) excludedCanonicalDirs + isExcludedDir Dir{canonicalPath} = canonicalPath `elem` excludedCanonicalDirs isExcludedDir File{} = False inputTreeFilter :: GalleryConfig -> InputTree -> Bool inputTreeFilter GalleryConfig{includedTags, excludedTags} = - (hasTagMatching $ anyPattern includedTags) - &&& (not . (hasTagMatching $ anyPattern excludedTags)) + hasTagMatching (anyPattern includedTags) + &&& (not . hasTagMatching (anyPattern excludedTags)) where hasTagMatching :: (String -> Bool) -> InputTree -> Bool - hasTagMatching cond = (any cond) . (fromMaybe [""] . tags) . sidecar + hasTagMatching cond = any cond . (fromMaybe [""] . tags) . sidecar compileGallery :: FilePath -> FilePath -> FilePath -> FilePath -> [FilePath] -> Bool -> Bool -> IO () diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 0ae0fa1..3c38a17 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs @@ -73,8 +73,8 @@ instance FromJSON GalleryConfig where <*> v .:? "includedTags" .!= ["*"] <*> v .:? "excludedTags" .!= [] <*> v .:? "tagCategories" .!= [] - <*> v .:? "tagsFromDirectories" .!= (TagsFromDirectoriesConfig 0 "") - <*> v .:? "thumbnailMaxResolution" .!= (Resolution 400 300) + <*> v .:? "tagsFromDirectories" .!= TagsFromDirectoriesConfig 0 "" + <*> v .:? "thumbnailMaxResolution" .!= Resolution 400 300 <*> v .:? "pictureMaxResolution" readConfig :: FileName -> IO GalleryConfig diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index c769815..40149e1 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs @@ -30,6 +30,7 @@ module Files import Data.List (isPrefixOf, length, subsequences, sortOn) import Data.Function ((&)) +import Data.Functor ((<&>)) import Data.Text (pack) import Data.Aeson (ToJSON) import qualified Data.Aeson as JSON @@ -53,7 +54,7 @@ type LocalPath = String type WebPath = String -- | Reversed path component list -data Path = Path [FileName] deriving Show +newtype Path = Path [FileName] deriving Show instance ToJSON Path where toJSON = JSON.String . pack . webPath @@ -120,7 +121,7 @@ isHidden = hiddenName . nodeName -- | DFS with intermediate dirs first. flattenDir :: FSNode -> [FSNode] flattenDir file@File{} = [file] -flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) +flattenDir dir@Dir{items} = dir:concatMap flattenDir items -- | Filters a dir tree. The root is always returned. filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode @@ -133,7 +134,7 @@ filterDir cond (AnchoredFSNode anchor root) = filter cond items & map filterNode & Dir path canonicalPath readDirectory :: LocalPath -> IO AnchoredFSNode -readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root +readDirectory root = AnchoredFSNode root <$> mkNode (Path []) where mkNode :: Path -> IO FSNode mkNode path = @@ -151,10 +152,10 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root mkDirNode :: Path -> FilePath -> IO FSNode mkDirNode path canonicalPath = - (listDirectory $ localPath (root /> path)) - >>= mapM (mkNode . ((>= return . sortOn nodeName - >>= return . Dir path canonicalPath + listDirectory (localPath (root /> path)) + >>= mapM (mkNode . (path sortOn nodeName + <&> Dir path canonicalPath copyTo :: FilePath -> AnchoredFSNode -> IO () copyTo target AnchoredFSNode{anchor, root} = copyNode root 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 diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 0efbf6d..73529ee 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -57,10 +57,7 @@ data Format = formatFromPath :: Path -> Format formatFromPath = - maybe Unknown fromExt - . fmap (map toLower) - . fmap takeExtension - . fileName + maybe Unknown ((fromExt . map toLower) . takeExtension) . fileName where fromExt :: String -> Format fromExt ext = case ext of @@ -97,12 +94,12 @@ type FileProcessor = copyFileProcessor :: FileProcessor copyFileProcessor inputPath outputPath = - (putStrLn $ "Copying:\t" ++ outputPath) + putStrLn ("Copying:\t" ++ outputPath) >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath resizePictureUpTo :: Resolution -> FileProcessor resizePictureUpTo maxResolution inputPath outputPath = - (putStrLn $ "Generating:\t" ++ outputPath) + putStrLn ("Generating:\t" ++ outputPath) >> ensureParentDir (flip resize) outputPath inputPath where maxSize :: Resolution -> String @@ -143,7 +140,7 @@ withCached processor inputPath outputPath = resourceAt :: FilePath -> Path -> IO Resource -resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath +resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = @@ -160,9 +157,7 @@ getImageResolution fsPath = _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." getPictureProps :: ItemDescriber -getPictureProps fsPath resource = - getImageResolution fsPath - >>= return . Picture resource +getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath type ItemDescriber = diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index c08677d..607c7f6 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -29,6 +29,7 @@ import Data.List.Ordered (minusBy) import Data.Char (toLower) import Data.Maybe (mapMaybe, fromMaybe) import Data.Function ((&)) +import Data.Functor ((<&>)) import qualified Data.Set as Set import Data.Text (pack) import Data.Time.Clock (UTCTime) @@ -119,8 +120,8 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) buildGalleryTree :: ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig -> InputTree -> IO GalleryItem -buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree = - mkGalleryItem [] inputTree +buildGalleryTree processItem processThumbnail tagsFromDirsConfig = + mkGalleryItem [] where mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = @@ -190,7 +191,7 @@ flattenGalleryTree simple = [simple] galleryOutputDiff :: GalleryItem -> FSNode -> [Path] galleryOutputDiff resources ref = - (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources) + filesystemPaths ref \\ compiledPaths (flattenGalleryTree resources) where filesystemPaths :: FSNode -> [Path] filesystemPaths = map Files.path . tail . flattenDir @@ -212,8 +213,7 @@ galleryOutputDiff resources ref = thumbnailPaths :: [GalleryItem] -> [Path] thumbnailPaths = - map resourcePath - . map (resource :: (Thumbnail -> Resource)) + map (resourcePath . (resource :: (Thumbnail -> Resource))) . mapMaybe thumbnail (\\) :: [Path] -> [Path] -> [Path] @@ -235,7 +235,7 @@ galleryOutputDiff resources ref = galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () galleryCleanupResourceDir resourceTree outputDir = readDirectory outputDir - >>= return . galleryOutputDiff resourceTree . root - >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs - >>= return . map (localPath . (/>) outputDir) + <&> galleryOutputDiff resourceTree . root + <&> sortOn ((0 -) . pathLength) -- nested files before their parent dirs + <&> map (localPath . (/>) outputDir) >>= mapM_ remove -- cgit v1.2.3