Merge #990: refactors & hlint rules

From what I know & in most cases `fold` is just as efficient as `{,m}concat` & `foldMap` as `concatMap`. I guard their effectiveness with supplying type signatures. `fold` enables `HLint` to provide further code refactoring instruction & to find function replacements by type signatures.

& further refactors, work actually started from `Inference` code refactors & tantrum spread, so currently trying to carve diff into small commits.

Author: Anton-Latukha

.hlint.yaml

@@ -2696,3 +2696,79 @@
     lhs: "maybe mempty a b"
     note: "Use `whenJust`"
     rhs: a `whenJust` b
+
+- hint:
+    lhs: "(mempty, mempty)"
+    note: "Is `mempty`"
+    rhs: mempty
+
+- hint:
+    lhs: "concat a"
+    note: "Use `fold`"
+    rhs: fold a
+
+- hint:
+    lhs: "mconcat a"
+    note: "Use `fold`"
+    rhs: fold a
+
+- hint:
+    lhs: "concatMap a"
+    note: "Use `foldMap`"
+    rhs: foldMap a
+
+- hint:
+    lhs: "[a]"
+    note: "Use `one`"
+    rhs: (one a)
+
+# Submitted upstream: https://github.com/ndmitchell/hlint/pull/1309 remove when merges
+- hint:
+    lhs: "either Left f e"
+    note: "Use `=<<`"
+    rhs: f =<< e
+
+- warn: {lhs: "init (one x)", rhs: "mempty", name: Evaluate}
+- warn: {lhs: "null (one x)", rhs: "False", name: Evaluate}
+- warn: {lhs: "foldr1 f (one x)", rhs: x, name: Evaluate}
+- warn: {lhs: "scanr f z mempty", rhs: "one z", name: Evaluate}
+- warn: {lhs: "scanr1 f mempty", rhs: "mempty", name: Evaluate}
+- warn: {lhs: "scanr1 f (one x)", rhs: "one x", name: Evaluate}
+- warn: {lhs: "fold (one a)", rhs: a, name: Evaluate}
+- warn: {lhs: "cycle (one x)", rhs: repeat x}
+- hint: {lhs: "\\x -> one x", rhs: "(one x)"}
+- hint: {lhs: "elem x (one y)", rhs: x == y, note: ValidInstance Eq a}
+- hint: {lhs: "notElem x (one y)", rhs: x /= y, note: ValidInstance Eq a}
+- warn: {lhs: "sequenceA (one a)", rhs: "pure <$> a"}
+- warn: {lhs: "head $ x <> one y", rhs: "headDef y x"}
+- warn: {lhs: "pictures (one p)", rhs: p, name: Evaluate}
+
+- hint:
+    lhs: "x : mempty"
+    note: "Use `one`"
+    rhs: one x
+- hint:
+    lhs: "x :| mempty"
+    note: "Use `one`"
+    rhs: one x
+
+- hint:
+    lhs: "join . fmap join"
+    note: "Monad law"
+    rhs: join . join
+
+- hint:
+    lhs: "join . fmap pure"
+    note: "Monad law"
+    rhs: id
+
+- hint:
+    lhs: "join . pure"
+    note: "Monad law"
+    rhs: id
+
+- hint:
+    lhs: "join . (f <<$>>)"
+    note: "Monad law"
+    rhs: fmap f . join
+

benchmarks/Main.hs

@@ -5,4 +5,4 @@ import           Criterion.Main
 import qualified ParserBench
 
 main :: IO ()
-main = defaultMain [ParserBench.benchmarks]
+main = defaultMain $ one ParserBench.benchmarks

main/Main.hs

@@ -123,7 +123,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
                 (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <>
                   ppShow (maybeToMonoid $ Map.lookup @VarName @[Scheme] "it" $ coerce ty)
                 )
-                (HM.inferTop mempty [("it", stripAnnotation expr')])
+                (HM.inferTop mempty (one ("it", stripAnnotation expr')))
 
                 -- liftIO $ putStrLn $ runST $
                 --     runLintM opts . renderSymbolic =<< lint opts expr

main/Repl.hs

@@ -111,7 +111,7 @@ main' iniVal =
         (words <$> lines f)
 
   handleMissing e
-    | Error.isDoesNotExistError e = pure ""
+    | Error.isDoesNotExistError e = pure mempty
     | otherwise = throwM e
 
   -- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline`
@@ -356,8 +356,7 @@ setConfig args =
 -- | Prefix tab completer
 defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]
 defaultMatcher =
-  [ (":load", Console.fileCompleter)
-  ]
+  one (":load", Console.fileCompleter)
 
 completion
   :: (MonadNix e t f m, MonadIO m)
@@ -424,7 +423,7 @@ completeFunc reversedPrev word
           shortBuiltins = M.keys builtins
 
       pure $ listCompletion $ toString <$>
-        ["__includes"]
+        one "__includes"
           <> contextKeys
           <> shortBuiltins
 
@@ -475,12 +474,12 @@ helpOptions :: (MonadNix e t f m, MonadIO m) => HelpOptions e t f m
 helpOptions =
   [ HelpOption
       "help"
-      ""
+      mempty
       "Print help text"
       (help helpOptions . fromString)
   , HelpOption
       "paste"
-      ""
+      mempty
       "Enter multi-line mode"
       (error "Unreachable")
   , HelpOption
@@ -490,7 +489,7 @@ helpOptions =
       (load . fromString)
   , HelpOption
       "browse"
-      ""
+      mempty
       "Browse bindings in interpreter context"
       (browse . fromString)
   , HelpOption
@@ -500,12 +499,12 @@ helpOptions =
       (typeof . fromString)
   , HelpOption
       "quit"
-      ""
+      mempty
       "Quit interpreter"
       quit
   , HelpOption
       "set"
-      ""
+      mempty
       ("Set REPL option"
         <> Prettyprinter.line
         <> "Available options:"
@@ -527,32 +526,32 @@ helpSetOptions :: [HelpSetOption]
 helpSetOptions =
   [ HelpSetOption
       "strict"
-      ""
+      mempty
       "Enable strict evaluation of REPL expressions"
       (\x -> x { cfgStrict = True})
   , HelpSetOption
       "lazy"
-      ""
+      mempty
       "Disable strict evaluation of REPL expressions"
       (\x -> x { cfgStrict = False})
   , HelpSetOption
       "values"
-      ""
+      mempty
       "Enable printing of value provenance information"
       (\x -> x { cfgValues = True})
   , HelpSetOption
       "novalues"
-      ""
+      mempty
       "Disable printing of value provenance information"
       (\x -> x { cfgValues = False})
   , HelpSetOption
       "debug"
-      ""
+      mempty
       "Enable printing of REPL debug information"
       (\x -> x { cfgDebug = True})
   , HelpSetOption
       "nodebug"
-      ""
+      mempty
       "Disable REPL debugging"
       (\x -> x { cfgDebug = False})
   ]