[#105] Add hlint support, enable -Weveryting

Problem: we had a lot redundant dependencies and had no linter for handling obvious errors

Solution: hlint support and enable -Weverything flag, fix all hints from them, add hlint to the CI pipeline

.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
 

.hlint.yaml

@@ -0,0 +1,100 @@
+# SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
+#
+# 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"

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
 

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

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

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

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

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
 

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