Address hlint warnings/suggestions (#1826)

* Switch to fourmolu formatter and reformat all sources

Some FOURMOLU_DISABLE directives were added in problematic cases
(mostly CPP conditional pragmas or foreign imports).

* Second pass to reduce amount of multi-line import lists

* Third pass, now with fourmolu-0.18.0.0

* Address hlint warnings

* Make it compile and pass tests

Address some hlints that required manual attention.

* Add hlint CI check

* Address review concern

* Drop conditional GHC-version sections

* Partially apply refactors

* Manually refactor return -> pure where automatic refactor failed

* Replace return with pure in literal haskell files

* How did this happen?

Author: zlondrej

.github/workflows/code-style.yaml

@@ -1,4 +1,4 @@
-name: Code style check
+name: Code style checks
 
 concurrency:
   group: formatting-${{ github.ref_name }}
@@ -20,4 +20,17 @@ jobs:
         uses: cachix/install-nix-action@v31
       - name: Check code formatting
         run: |
-          nix develop '#haskellFormatter' --command fourmolu --mode=check --check-idempotence servant servant-*
+          nix develop '#haskellFormatter' --command fourmolu --mode=check --check-idempotence servant servant-*
+
+  lint:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout Code
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 1
+      - name: Install Nix
+        uses: cachix/install-nix-action@v31
+      - name: Run hlint check
+        run: |
+          nix develop '#haskellLinter' --command hlint servant servant-*

hlint.yaml renamed to .hlint.yaml

@@ -45,15 +45,12 @@
 #
 # Generalise map to fmap, ++ to <>
 # - group: {name: generalise, enabled: true}
+#
+# Replace return with pure
+- group: {name: future, enabled: true}
 
 
 # Ignore some builtin hints
-- ignore: {name: Redundant do}
-- ignore: {name: Parse error}
-- ignore: {name: Use fmap}
-- ignore: {name: Use list comprehension}
-- ignore: {name: Use lambda-case}
-- ignore: {name: Eta reduce}
 # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
 
 

doc/cookbook/basic-auth/BasicAuth.lhs

@@ -71,7 +71,7 @@ api :: Proxy API
 api = Proxy
 
 server :: Server API
-server usr = return (site usr)
+server usr = pure (site usr)
 ```
 
 In order to protect our endpoint (`"mysite" :> Get '[JSON] Website`), we simply
@@ -105,10 +105,10 @@ checkBasicAuth db = BasicAuthCheck $ \basicAuthData ->
       password = decodeUtf8 (basicAuthPassword basicAuthData)
   in
   case Map.lookup username db of
-    Nothing -> return NoSuchUser
+    Nothing -> pure NoSuchUser
     Just u  -> if pass u == password
-               then return (Authorized u)
-               else return BadPassword
+               then pure (Authorized u)
+               else pure BadPassword
 ```
 
 This check simply looks up the user in the "database" and makes sure the

doc/cookbook/basic-streaming/Streaming.lhs

@@ -8,12 +8,12 @@ In other words, without streaming libraries.
 - Some basic usage doesn't require usage of streaming libraries,
   like `conduit`, `pipes`, `machines` or `streaming`.
   We have bindings for them though.
-- Similar example is bundled with each of our streaming library interop packages (see 
+- Similar example is bundled with each of our streaming library interop packages (see
 [servant-pipes](https://github.com/haskell-servant/servant/blob/master/servant-pipes/example/Main.hs),
 [servant-conduit](https://github.com/haskell-servant/servant/blob/master/servant-conduit/example/Main.hs) and
 [servant-machines](https://github.com/haskell-servant/servant/blob/master/servant-machines/example/Main.hs))
 - `SourceT` doesn't have *Prelude* with handy combinators, so we have to write
-  things ourselves. (Note to self: `mapM` and `foldM` would be handy to have). 
+  things ourselves. (Note to self: `mapM` and `foldM` would be handy to have).
 
 ## Code
 
@@ -64,19 +64,19 @@ server :: Server API
 server = fast :<|> slow :<|> readme :<|> proxy where
     fast n = liftIO $ do
         putStrLn $ "/get/" ++ show n
-        return $ fastSource n
+        pure $ fastSource n
 
     slow n = liftIO $ do
         putStrLn $ "/slow/" ++ show n
-        return $ slowSource n
+        pure $ slowSource n
 
     readme = liftIO $ do
         putStrLn "/proxy"
-        return (S.readFile "README.md")
+        pure (S.readFile "README.md")
 
     proxy c = liftIO $ do
         putStrLn "/proxy"
-        return c
+        pure c
 
     -- for some reason unfold leaks?
     fastSource = S.fromStepT . mk where
@@ -116,8 +116,8 @@ main = do
                     x <- S.unSourceT src (go (0 :: Int))
                     print x
                   where
-                    go !acc S.Stop        = return acc
-                    go !acc (S.Error err) = print err >> return acc
+                    go !acc S.Stop        = pure acc
+                    go !acc (S.Error err) = print err >> pure acc
                     go !acc (S.Skip s)    = go acc s
                     go !acc (S.Effect ms) = ms >>= go acc
                     go !acc (S.Yield _ s) = go (acc + 1) s

doc/cookbook/curl-mock/CurlMock.lhs

@@ -141,10 +141,10 @@ generateEndpoint :: Text -> Req Mocked -> IO Text
 generateEndpoint host req =
   case maybeBody of
     Just body ->
-      body >>= \b -> return $ T.intercalate " " [ "curl", "-X", method, "-d", "'" <> b <> "'"
+      body >>= \b -> pure $ T.intercalate " " [ "curl", "-X", method, "-d", "'" <> b <> "'"
                                                 , "-H 'Content-Type: application/json'", host <> "/" <> url ]
     Nothing ->
-      return $ T.intercalate " " [ "curl", "-X", method, host <> "/" <> url ]
+      pure $ T.intercalate " " [ "curl", "-X", method, host <> "/" <> url ]
   where
     method = decodeUtf8 $ req ^. reqMethod
 

doc/cookbook/custom-errors/CustomErrors.lhs

@@ -67,12 +67,12 @@ server :: Server TestApi
 server = helloH :<|> postGreetH :<|> deleteGreetH
 
   where helloH name Nothing = helloH name (Just False)
-        helloH name (Just False) = return . Greet $ "Hello, " <> name
-        helloH name (Just True) = return . Greet . Text.toUpper $ "Hello, " <> name
+        helloH name (Just False) = pure . Greet $ "Hello, " <> name
+        helloH name (Just True) = pure . Greet . Text.toUpper $ "Hello, " <> name
 
-        postGreetH greet = return greet
+        postGreetH greet = pure greet
 
-        deleteGreetH _ = return NoContent
+        deleteGreetH _ = pure NoContent
 ```
 
 ## Error formatters

doc/cookbook/db-mysql-basics/MysqlBasics.lhs

@@ -141,9 +141,9 @@ doMigration :: IO ()
 doMigration = runNoLoggingT $ runResourceT $ withMySQLConn connInfo $ runReaderT $ runMigration migrateAll
 
 server :: Server Api
-server = 
-  personGET :<|> 
-  personGETById :<|> 
+server =
+  personGET :<|>
+  personGETById :<|>
   personDELETE :<|>
   personPOST
     where
@@ -155,20 +155,20 @@ server =
 selectPersons :: Handler [Person]
 selectPersons = do
   personList <- runDB $ selectList [] []
-  return $ map (\(Entity _ u) -> u) personList
+  pure $ map (\(Entity _ u) -> u) personList
 
 selectPersonById :: Int -> Handler Person
 selectPersonById id = do
   sqlResult <- runDB $ get $ PersonKey id
   case sqlResult of
-    Just person -> return person
+    Just person -> pure person
     Nothing -> throwError err404 { errBody = JSON.encode "Person with ID not found." }
 
 createPerson :: Person -> Handler Person
 createPerson person = do
   attemptCreate <- runDB $ insert person
   case attemptCreate of
-    PersonKey k -> return person
+    PersonKey k -> pure person
     _           -> throwError err503 { errBody = JSON.encode "Could not create Person." }
 
 deletePerson :: Int -> Handler ()

doc/cookbook/db-postgres-pool/PostgresPool.lhs

@@ -51,7 +51,7 @@ initDB :: DBConnectionString -> IO ()
 initDB connstr = bracket (connectPostgreSQL connstr) close $ \conn -> do
   execute_ conn
     "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
-  return ()
+  pure ()
 ```
 
 Next, our server implementation. It will be parametrised (take as
@@ -76,7 +76,7 @@ server conns = postMessage :<|> getMessages
             execute conn
                     "INSERT INTO messages VALUES (?)"
                     (Only msg)
-          return NoContent
+          pure NoContent
 
         getMessages :: Handler [Message]
         getMessages = fmap (map fromOnly) . liftIO $

doc/cookbook/db-sqlite-simple/DBConnection.lhs

@@ -59,7 +59,7 @@ server dbfile = postMessage :<|> getMessages
             execute conn
                     "INSERT INTO messages VALUES (?)"
                     (Only msg)
-          return NoContent
+          pure NoContent
 
         getMessages :: Handler [Message]
         getMessages = fmap (map fromOnly) . liftIO $

doc/cookbook/file-upload/FileUpload.lhs

@@ -82,7 +82,7 @@ upload multipartData = do
       let content = fdPayload file
       putStrLn $ "Content of " ++ show (fdFileName file)
       LBS.putStr content
-  return 0
+  pure 0
 
 startServer :: IO ()
 startServer = run 8080 (serve api upload)