From b64dd04795eee363807a5a0fcaf08f1c00ef5849 Mon Sep 17 00:00:00 2001 From: Tom Sydney Kerckhove Date: Sun, 11 Aug 2024 15:19:55 +0200 Subject: [PATCH] apply hlint suggestions --- .hlint.yaml | 4 ++++ flake.nix | 1 + path/src/Path/Include.hs | 21 ++++++++++----------- path/test-ospath/Common/Include.hs | 1 - path/test/Posix.hs | 2 +- path/test/Windows.hs | 2 +- path/validity-test/Path/Gen.hs | 2 +- 7 files changed, 18 insertions(+), 15 deletions(-) create mode 100644 .hlint.yaml diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..1de661b --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,4 @@ +- ignore: + name: "Redundant if" +- ignore: + name: "Use unless" diff --git a/flake.nix b/flake.nix index 1a45320..ffa995a 100644 --- a/flake.nix +++ b/flake.nix @@ -36,6 +36,7 @@ nixpkgs-fmt.enable = true; nixpkgs-fmt.excludes = [ ".*/default.nix" ]; deadnix.enable = true; + hlint.enable = true; cabal2nix.enable = true; }; }; diff --git a/path/src/Path/Include.hs b/path/src/Path/Include.hs index 76ae14e..151325a 100644 --- a/path/src/Path/Include.hs +++ b/path/src/Path/Include.hs @@ -24,7 +24,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} module Path.PLATFORM_NAME (-- * Types @@ -103,7 +102,7 @@ module Path.PLATFORM_NAME import Control.Applicative (Alternative(..)) import Control.DeepSeq (NFData (..)) import Control.Exception (Exception(..)) -import Control.Monad (liftM, when) +import Control.Monad (when) import Control.Monad.Catch (MonadThrow(..)) import Data.Aeson (FromJSON (..), FromJSONKey(..), ToJSON(..)) import qualified Data.Aeson.Types as Aeson @@ -462,10 +461,10 @@ dirname (Path l) = Path (last (FilePath.splitPath l)) -- @since 0.7.0 splitExtension :: MonadThrow m => Path b File -> m (Path b File, String) splitExtension (Path fpath) = - if nameDot == [] || ext == [] + if null nameDot || null ext then throwM $ HasNoExtension fpath else let fname = init nameDot - in if fname == [] || fname == "." || fname == ".." + in if null fname || fname == "." || fname == ".." then throwM $ HasNoExtension fpath else return ( Path (normalizeDrive drv ++ dir ++ fname) , FilePath.extSeparator : ext @@ -499,7 +498,7 @@ splitExtension (Path fpath) = -- -- @since 0.5.11 fileExtension :: MonadThrow m => Path b File -> m String -fileExtension = (liftM snd) . splitExtension +fileExtension = fmap snd . splitExtension -- | Add extension to given file path. -- @@ -541,7 +540,7 @@ addExtension ext (Path path) = do throwM $ InvalidExtension ex -- just a "." is not a valid extension - when (xs == []) $ + when (null xs) $ throwM $ InvalidExtension ex -- cannot have path separators @@ -550,7 +549,7 @@ addExtension ext (Path path) = do -- All "."s is not a valid extension let ys = dropWhile FilePath.isExtSeparator (reverse xs) - when (ys == []) $ + when (null ys) $ throwM $ InvalidExtension ex -- Cannot have "."s except in trailing position @@ -586,8 +585,8 @@ addFileExtension :: MonadThrow m -> m (Path b File) -- ^ New file name with the desired extension added at the end addFileExtension ext (Path path) = if FilePath.isAbsolute path - then liftM coercePath (parseAbsFile (FilePath.addExtension path ext)) - else liftM coercePath (parseRelFile (FilePath.addExtension path ext)) + then fmap coercePath (parseAbsFile (FilePath.addExtension path ext)) + else fmap coercePath (parseRelFile (FilePath.addExtension path ext)) where coercePath :: Path a b -> Path a' b' coercePath (Path a) = Path a @@ -636,8 +635,8 @@ setFileExtension :: MonadThrow m -> m (Path b File) -- ^ New file name with the desired extension setFileExtension ext (Path path) = if FilePath.isAbsolute path - then liftM coercePath (parseAbsFile (FilePath.replaceExtension path ext)) - else liftM coercePath (parseRelFile (FilePath.replaceExtension path ext)) + then fmap coercePath (parseAbsFile (FilePath.replaceExtension path ext)) + else fmap coercePath (parseRelFile (FilePath.replaceExtension path ext)) where coercePath :: Path a b -> Path a' b' coercePath (Path a) = Path a diff --git a/path/test-ospath/Common/Include.hs b/path/test-ospath/Common/Include.hs index cce3510..e045304 100644 --- a/path/test-ospath/Common/Include.hs +++ b/path/test-ospath/Common/Include.hs @@ -6,7 +6,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -- | Test functions that are common to Posix and Windows module Common.PLATFORM_NAME diff --git a/path/test/Posix.hs b/path/test/Posix.hs index 932ffaf..f66fe43 100644 --- a/path/test/Posix.hs +++ b/path/test/Posix.hs @@ -148,7 +148,7 @@ aesonInstances = it "Decoding \"[\"/foo/bar\"]\" as a [Path Rel Dir] should fail." $ decode (LBS.pack "[\"/foo/bar\"]") `shouldBe` (Nothing :: Maybe [Path Rel Dir]) it "Encoding \"[\"/foo/bar/mu.txt\"]\" should succeed." $ - encode [Path "/foo/bar/mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"/foo/bar/mu.txt\"]") + encode [Path "/foo/bar/mu.txt" :: Path Abs File] `shouldBe` LBS.pack "[\"/foo/bar/mu.txt\"]" -- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors. quasiquotes :: Spec diff --git a/path/test/Windows.hs b/path/test/Windows.hs index 24f6075..1529fca 100644 --- a/path/test/Windows.hs +++ b/path/test/Windows.hs @@ -158,7 +158,7 @@ aesonInstances = it "Decoding \"[\"C:\\foo\\bar\"]\" as a [Path Rel Dir] should fail." $ decode (LBS.pack "[\"C:\\foo\\bar\"]") `shouldBe` (Nothing :: Maybe [Path Rel Dir]) it "Encoding \"[\"C:\\foo\\bar\\mu.txt\"]\" should succeed." $ - encode [Path "C:\\foo\\bar\\mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"C:\\\\foo\\\\bar\\\\mu.txt\"]") + encode [Path "C:\\foo\\bar\\mu.txt" :: Path Abs File] `shouldBe` LBS.pack "[\"C:\\\\foo\\\\bar\\\\mu.txt\"]" -- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors. quasiquotes :: Spec diff --git a/path/validity-test/Path/Gen.hs b/path/validity-test/Path/Gen.hs index e141a9d..783c555 100644 --- a/path/validity-test/Path/Gen.hs +++ b/path/validity-test/Path/Gen.hs @@ -123,4 +123,4 @@ genPathyChar :: Gen Char genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")] shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b] -shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkValid f +shrinkValidWith fun (Path f) = filter (/= Path f) . mapMaybe fun $ shrinkValid f