diff --git a/.buildkite/pipeline.yml b/.buildkite/pipeline.yml index 6df7cf5..2b11553 100644 --- a/.buildkite/pipeline.yml +++ b/.buildkite/pipeline.yml @@ -25,6 +25,9 @@ steps: - command: nix run -f ci.nix xrefcheck-static -c xrefcheck --ignored tests/markdowns label: Xrefcheck itself + - label: lint + command: nix run -f ci.nix pkgs.haskellPackages.hlint -c hlint . + - command: nix run -f ci.nix pkgs.reuse -c reuse lint label: REUSE lint diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..180cc78 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,100 @@ +# SPDX-FileCopyrightText: 2022 Serokell +# +# SPDX-License-Identifier: Unlicense + +########################################################################### +# Settings +########################################################################### + +- arguments: [-XTypeApplications, -XRecursiveDo, -XBlockArguments, -XQuasiQuotes] + +# These are just too annoying +- ignore: { name: Redundant do } +- ignore: { name: Redundant bracket } +- ignore: { name: Redundant lambda } +- ignore: { name: Redundant $ } +- ignore: { name: Redundant flip } +- ignore: { name: Move brackets to avoid $ } +- ignore: { name: Avoid lambda using `infix` } + +# Losing variable names can be not-nice +- ignore: { name: Eta reduce } +- ignore: { name: Avoid lambda } + +# Humans know better +- ignore: { name: Use camelCase } +- ignore: { name: Use const } +- ignore: { name: Use section } +- ignore: { name: Use if } +- ignore: { name: Use notElem } +- ignore: { name: Use fromMaybe } +- ignore: { name: Replace case with fromMaybe } +- ignore: { name: Use maybe } +- ignore: { name: Use fmap } +- ignore: { name: Use foldl } +- ignore: { name: "Use :" } +- ignore: { name: Use ++ } +- ignore: { name: Use || } +- ignore: { name: Use && } +- ignore: { name: 'Use ?~' } +- ignore: { name: Use <$> } +- ignore: { name: Use unless } + +# Sometimes [Char] is okay (if it means "a sequence of characters") +- ignore: { name: Use String } + +# Sometimes TemplateHaskell is needed to please stylish-haskell +- ignore: { name: Unused LANGUAGE pragma } + +# Some 'data' records will be extended with more fields later, +# so they shouldn't be replaced with 'newtype' blindly +- ignore: { name: Use newtype instead of data } + +########################################################################### +# Various stuff +########################################################################### + +- warn: + name: "Avoid 'both'" + lhs: both + rhs: Control.Lens.each + note: | + If you use 'both' on a 2-tuple and later it's accidentally + replaced with a longer tuple, 'both' will be silently applied to only + the *last two elements* instead of failing with a type error. + * If you want to traverse all elements of the tuple, use 'each'. + * If 'both' is used on 'Either' here, replace it with 'chosen'. + +- warn: { lhs: either (const True) (const False), rhs: isLeft } +- warn: { lhs: either (const False) (const True), rhs: isRight } + +- warn: { lhs: map fst &&& map snd, rhs: unzip } + +- warn: + name: "'fromIntegral' is unsafe without type annotations." + lhs: fromIntegral x + rhs: fromIntegral @t1 @t2 x +- warn: + name: "'fromIntegral' is unsafe without TWO type annotations." + lhs: fromIntegral @t1 x + rhs: fromIntegral @t1 @t2 x +- warn: + name: "Avoid the use of '(+||)' and '(||+)'" + lhs: '(Fmt.+||)' + rhs: '(Fmt.+|)' + note: "The use of '(+||)' may result in outputting raw Haskell into user-facing code" +- warn: + name: "Avoid the use of '(+||)' and '(||+)'" + lhs: '(Fmt.||+)' + rhs: '(Fmt.|+)' + note: "The use of '(||+)' may result in outputting raw Haskell into user-facing code" +- warn: + name: "Avoid the use of '(||++||)'" + lhs: '(Fmt.||++||)' + rhs: '(Fmt.|++|)' + note: "The use of '(||++||)' may result in outputting raw Haskell into user-facing code" +- warn: + name: "Avoid the use of '(||++|)'" + lhs: '(Fmt.||++|)' + rhs: '(Fmt.|++|)' + note: "The use of '(||++|)' may result in outputting raw Haskell into user-facing code" diff --git a/links-tests/Test/Xrefcheck/FtpLinks.hs b/links-tests/Test/Xrefcheck/FtpLinks.hs index c6bed32..729dad2 100644 --- a/links-tests/Test/Xrefcheck/FtpLinks.hs +++ b/links-tests/Test/Xrefcheck/FtpLinks.hs @@ -3,8 +3,7 @@ -- SPDX-License-Identifier: MPL-2.0 module Test.Xrefcheck.FtpLinks - ( FtpHostOpt(..) - , ftpOptions + ( ftpOptions , test_FtpLinks ) where diff --git a/package.yaml b/package.yaml index 954f26f..3a404c5 100644 --- a/package.yaml +++ b/package.yaml @@ -51,50 +51,21 @@ default-extensions: - TypeOperators ghc-options: - - -Wall + - -Weverything - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wmissing-deriving-strategies + - -Wno-missing-safe-haskell-mode + - -Wno-unsafe + - -Wno-missing-import-lists + - -Wno-missing-local-signatures + - -Wno-missing-export-lists + - -Wno-all-missed-specialisations + - -Wno-prepositive-qualified-module + - -Wno-monomorphism-restriction dependencies: - - aeson - - aeson-casing - - async - base - - bytestring - - containers - - cmark-gfm - - data-default - - deepseq - - directory-tree - - directory - - dlist - - filepath - - raw-strings-qq - - fmt - - ftp-client - - Glob - - http-client - - http-types - - HUnit - - lens - - pretty-terminal - - modern-uri - - mtl - - o-clock - - optparse-applicative - - regex-tdfa - - req - - regex-tdfa - - roman-numerals - - template-haskell - - text - - text-metrics - - th-lift-instances - - transformers - - universum - - yaml - - with-utf8 library: source-dirs: src @@ -102,6 +73,39 @@ library: generated-other-modules: - Paths_xrefcheck + dependencies: + - aeson + - aeson-casing + - async + - bytestring + - containers + - cmark-gfm + - data-default + - directory-tree + - directory + - dlist + - filepath + - raw-strings-qq + - fmt + - ftp-client + - Glob + - http-client + - http-types + - lens + - pretty-terminal + - modern-uri + - mtl + - o-clock + - optparse-applicative + - regex-tdfa + - req + - roman-numerals + - text + - text-metrics + - th-lift-instances + - universum + - yaml + executables: xrefcheck: main: Main.hs @@ -115,6 +119,9 @@ executables: - -O2 dependencies: - xrefcheck + - bytestring + - universum + - with-utf8 tests: xrefcheck-tests: @@ -128,6 +135,14 @@ tests: - hspec-expectations - QuickCheck - xrefcheck + - bytestring + - directory + - fmt + - http-types + - HUnit + - regex-tdfa + - universum + - yaml build-tools: - hspec-discover @@ -143,3 +158,4 @@ tests: - tasty - tasty-hunit - xrefcheck + - universum diff --git a/src/Xrefcheck/Progress.hs b/src/Xrefcheck/Progress.hs index 70a3bad..4af4ed3 100644 --- a/src/Xrefcheck/Progress.hs +++ b/src/Xrefcheck/Progress.hs @@ -43,11 +43,11 @@ initProgress :: Num a => a -> Progress a initProgress a = Progress{ pTotal = a, pCurrent = 0, pErrors = 0 } -- | Increase progress amount. -incProgress :: (Num a, Show a) => Progress a -> Progress a +incProgress :: (Num a) => Progress a -> Progress a incProgress Progress{..} = Progress{ pCurrent = pCurrent + 1, .. } -- | Increase errors amount. -incProgressErrors :: (Num a, Show a) => Progress a -> Progress a +incProgressErrors :: (Num a) => Progress a -> Progress a incProgressErrors Progress{..} = Progress{ pErrors = pErrors + 1, .. } -- | Visualise progress bar. @@ -59,8 +59,8 @@ showProgress name width col Progress{..} = mconcat , status ] where - done = floor $ (pCurrent % pTotal) * fromIntegral width - errs = ceiling $ (pErrors % pTotal) * fromIntegral width + done = floor $ (pCurrent % pTotal) * fromIntegral @Int @(Ratio Int) width + errs = ceiling $ (pErrors % pTotal) * fromIntegral @Int @(Ratio Int) width done' = max 0 $ done - errs remained' = width - errs - done' bar diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs index 9dbad32..92ec047 100644 --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -119,7 +119,6 @@ foldNode action node@(Node _ _ subs) = do nodeExtractInfo :: forall m . ( MonadError Text m - , MonadState IgnoreMode m , MonadReader MarkdownConfig m ) => Node diff --git a/src/Xrefcheck/Verify.hs b/src/Xrefcheck/Verify.hs index f3be215..16199d6 100644 --- a/src/Xrefcheck/Verify.hs +++ b/src/Xrefcheck/Verify.hs @@ -70,9 +70,7 @@ deriving newtype instance Semigroup (VerifyResult e) deriving newtype instance Monoid (VerifyResult e) instance Buildable e => Buildable (VerifyResult e) where - build vr = case verifyErrors vr of - Nothing -> "ok" - Just errs -> listF errs + build vr = maybe "ok" listF (verifyErrors vr) verifyOk :: VerifyResult e -> Bool verifyOk (VerifyResult errors) = null errors diff --git a/tests/Test/Xrefcheck/AnchorsSpec.hs b/tests/Test/Xrefcheck/AnchorsSpec.hs index e3de665..470ff49 100644 --- a/tests/Test/Xrefcheck/AnchorsSpec.hs +++ b/tests/Test/Xrefcheck/AnchorsSpec.hs @@ -3,7 +3,7 @@ - SPDX-License-Identifier: MPL-2.0 -} -module Test.Xrefcheck.AnchorsSpec where +module Test.Xrefcheck.AnchorsSpec (spec) where import Universum diff --git a/xrefcheck.nix b/xrefcheck.nix index 7c1fa99..d76fc58 100644 --- a/xrefcheck.nix +++ b/xrefcheck.nix @@ -11,7 +11,9 @@ let src = pkgs.haskell-nix.haskellLib.cleanGit { src = ./.; }; modules = [{ packages.xrefcheck = { - ghcOptions = [ "-Werror" ]; + ghcOptions = + [ "-Werror" ]; + components.tests = { links-tests = { build-tools = [ pkgs.vsftpd ]; @@ -40,4 +42,5 @@ let }; }]; }; -in project.xrefcheck +in +project.xrefcheck