Use hlint

.github/workflows/hlint.yaml

@@ -0,0 +1,19 @@
+name: HLint
+on: push
+
+jobs:
+  hlint:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v4
+
+    - name: 'Set up HLint'
+      uses: haskell-actions/hlint-setup@v2
+      with:
+        version: '3.8'
+
+    - name: 'Run HLint'
+      uses: haskell-actions/hlint-run@v2
+      with:
+        path: .
+        fail-on: warning

.hlint.yaml

@@ -0,0 +1,15 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# Replace a $ b $ c with a . b $ c
+- group: {name: dollar, enabled: true}
+
+- ignore: {name: "Functor law"}
+- ignore: {name: "Redundant do"}
+- ignore: {name: "Use <=<"}
+- ignore: {name: "Use camelCase"}
+
+- warn: {lhs: fmap f $ g, rhs: f <$> g}
+- warn: {lhs: maybe x identity, rhs: fromMaybe x}
+- warn: {lhs: return, rhs: pure}

examples/Catalog.hs

@@ -23,7 +23,7 @@ getConnSettings :: IO ConnectionSettings
 getConnSettings = do
   args <- getArgs
   case args of
-    [conninfo] -> return defaultConnectionSettings {csConnInfo = T.pack conninfo}
+    [conninfo] -> pure defaultConnectionSettings {csConnInfo = T.pack conninfo}
     _ -> do
       prog <- getProgName
       error $ "Usage:" <+> prog <+> "<connection info>"
@@ -113,15 +113,15 @@ processCommand cs cmd = case parse cmd of
     Just (name :: String) ->
       runDBT cs defaultTransactionSettings . runQuery_ $
         "INSERT INTO authors_ (name) VALUES (" <?> name <+> ")"
-    Nothing -> printLn $ "Invalid name"
+    Nothing -> printLn "Invalid name"
   -- Insert a book.
   ("insert_book", mbook) -> case mread mbook of
     Just record ->
       runDBT cs defaultTransactionSettings . runQuery_ $
         rawSQL
           "INSERT INTO books_ (name, year, author_id) VALUES ($1, $2, $3)"
           (record :: (String, Int32, Int64))
-    Nothing -> printLn $ "Invalid book record"
+    Nothing -> printLn "Invalid book record"
   -- Handle unknown commands.
   _ -> printLn $ "Unknown command:" <+> cmd
   where

examples/OuterJoins.hs

@@ -19,7 +19,7 @@ getConnSettings :: IO ConnectionSettings
 getConnSettings = do
   args <- getArgs
   case args of
-    [conninfo] -> return defaultConnectionSettings {csConnInfo = T.pack conninfo}
+    [conninfo] -> pure defaultConnectionSettings {csConnInfo = T.pack conninfo}
     _ -> do
       prog <- getProgName
       error $ "Usage:" <+> prog <+> "<connection info>"

hpqtypes.cabal

@@ -163,13 +163,13 @@ library
                     , RecordWildCards
                     , ScopedTypeVariables
                     , StandaloneDeriving
+                    , TypeApplications
                     , TupleSections
                     , TypeFamilies
                     , TypeOperators
                     , UndecidableInstances
   other-extensions:   AllowAmbiguousTypes
                     , CPP
-                    , TypeApplications
 
 test-suite hpqtypes-tests
   type:              exitcode-stdio-1.0
@@ -232,6 +232,7 @@ test-suite hpqtypes-tests
                     , ScopedTypeVariables
                     , StandaloneDeriving
                     , TupleSections
+                    , TypeApplications
                     , TypeFamilies
                     , TypeOperators
                     , UndecidableInstances

src/Database/PostgreSQL/PQTypes/Array.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Database.PostgreSQL.PQTypes.Array
   ( -- * Array1
     Array1 (..)
@@ -59,7 +57,7 @@ instance FromSQL t => FromSQL (Array1 t) where
       getItem res err i ptr fmt = do
         verifyPQTRes err "fromSQL (Array1)" =<< c_PQgetf1 res err i fmt 0 ptr
         isNull <- c_PQgetisnull res i 0
-        mbase <- if isNull == 1 then return Nothing else Just <$> peek ptr
+        mbase <- if isNull == 1 then pure Nothing else Just <$> peek ptr
         fromSQL mbase
 
 instance ToSQL t => ToSQL (Array1 t) where
@@ -160,7 +158,7 @@ getArray1 con PGarray {..} getItem =
   where
     loop :: [t] -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
     loop acc !i err ptr fmt = case i of
-      -1 -> return . con $ acc
+      -1 -> pure . con $ acc
       _ -> do
         item <- getItem pgArrayRes err i ptr fmt `E.catch` rethrowWithArrayError i
         loop (item : acc) (i - 1) err ptr fmt
@@ -186,7 +184,7 @@ instance FromSQL t => FromSQL (Array2 t) where
       getItem res err i ptr fmt = do
         verifyPQTRes err "fromSQL (Array2)" =<< c_PQgetf1 res err i fmt 0 ptr
         isNull <- c_PQgetisnull res i 0
-        mbase <- if isNull == 1 then return Nothing else Just <$> peek ptr
+        mbase <- if isNull == 1 then pure Nothing else Just <$> peek ptr
         fromSQL mbase
 
 instance ToSQL t => ToSQL (Array2 t) where
@@ -258,17 +256,15 @@ putArray2 arr param conv putItem = do
   where
     loop :: [[t]] -> CInt -> CInt -> CString -> IO (V.Vector CInt)
     loop rows !size !innerSize fmt = case rows of
-      [] -> return . V.fromList $ [size, innerSize]
+      [] -> pure . V.fromList $ [size, innerSize]
       (row : rest) -> do
         nextInnerSize <- innLoop row 0 fmt
-        when (size > 0 && innerSize /= nextInnerSize) $
-          hpqTypesError $
-            "putArray2: inner rows have different sizes"
+        when (size > 0 && innerSize /= nextInnerSize) . hpqTypesError $ "putArray2: inner rows have different sizes"
         loop rest (size + 1) nextInnerSize fmt
 
     innLoop :: [t] -> CInt -> CString -> IO CInt
     innLoop items !size fmt = case items of
-      [] -> return size
+      [] -> pure size
       (item : rest) -> do
         putItem fmt item
         innLoop rest (size + 1) fmt
@@ -304,15 +300,15 @@ getArray2 con PGarray {..} getItem = flip E.finally (c_PQclear pgArrayRes) $ do
   where
     loop :: [[t]] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO array
     loop acc dim2 !i err ptr fmt = case i of
-      0 -> return . con $ acc
+      0 -> pure . con $ acc
       _ -> do
         let i' = i - dim2
         arr <- innLoop [] (dim2 - 1) i' err ptr fmt
         loop (arr : acc) dim2 i' err ptr fmt
 
     innLoop :: [t] -> CInt -> CInt -> Ptr PGerror -> Ptr a -> CString -> IO [t]
     innLoop acc !i baseIdx err ptr fmt = case i of
-      -1 -> return acc
+      -1 -> pure acc
       _ -> do
         let i' = baseIdx + i
         item <- getItem pgArrayRes err i' ptr fmt `E.catch` rethrowWithArrayError i'

src/Database/PostgreSQL/PQTypes/Composite.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Database.PostgreSQL.PQTypes.Composite
   ( Composite (..)
   , unComposite

src/Database/PostgreSQL/PQTypes/Fold.hs

@@ -9,6 +9,7 @@ module Database.PostgreSQL.PQTypes.Fold
   ) where
 
 import Control.Monad.Catch
+import Data.Functor
 import GHC.Stack
 
 import Database.PostgreSQL.PQTypes.Class
@@ -24,7 +25,7 @@ queryResult
 queryResult =
   withFrozenCallStack $
     getQueryResult
-      >>= maybe (throwDB . HPQTypesError $ "queryResult: no query result") return
+      >>= maybe (throwDB . HPQTypesError $ "queryResult: no query result") pure
 
 ----------------------------------------
 
@@ -37,7 +38,7 @@ foldrDB
 foldrDB f acc =
   withFrozenCallStack $
     getQueryResult
-      >>= maybe (return acc) (foldrImpl False f acc)
+      >>= maybe (pure acc) (foldrImpl False f acc)
 
 -- | Fetcher of rows returned by a query as a monadic left fold.
 foldlDB
@@ -48,7 +49,7 @@ foldlDB
 foldlDB f acc =
   withFrozenCallStack $
     getQueryResult
-      >>= maybe (return acc) (foldlImpl False f acc)
+      >>= maybe (pure acc) (foldlImpl False f acc)
 
 -- | Fetcher of rows returned by a query as a monadic map.
 mapDB_
@@ -58,13 +59,13 @@ mapDB_
 mapDB_ f =
   withFrozenCallStack $
     getQueryResult
-      >>= maybe (return ()) (foldlImpl False (\() row -> () <$ f row) ())
+      >>= maybe (pure ()) (foldlImpl False (\() row -> void (f row)) ())
 
 ----------------------------------------
 
 -- | Specialization of 'foldrDB' that fetches a list of rows.
 fetchMany :: (HasCallStack, MonadDB m, FromRow row) => (row -> t) -> m [t]
-fetchMany f = withFrozenCallStack $ foldrDB (\row acc -> return $ f row : acc) []
+fetchMany f = withFrozenCallStack $ foldrDB (\row acc -> pure $ f row : acc) []
 
 -- | Specialization of 'foldlDB' that fetches one or zero rows. If
 -- more rows are delivered, 'AffectedRowsMismatch' exception is thrown.
@@ -73,11 +74,11 @@ fetchMaybe
   => (row -> t)
   -> m (Maybe t)
 fetchMaybe f = withFrozenCallStack $ do
-  getQueryResult >>= \mqr -> case mqr of
-    Nothing -> return Nothing
+  getQueryResult >>= \case
+    Nothing -> pure Nothing
     Just qr -> fst <$> foldlDB go (Nothing, f <$> qr)
   where
-    go (Nothing, qr) row = return (Just $ f row, qr)
+    go (Nothing, qr) row = pure (Just $ f row, qr)
     go (Just _, qr) _ =
       throwDB
         AffectedRowsMismatch
@@ -91,7 +92,7 @@ fetchOne :: (HasCallStack, MonadDB m, MonadThrow m, FromRow row) => (row -> t) -
 fetchOne f = withFrozenCallStack $ do
   mt <- fetchMaybe f
   case mt of
-    Just t -> return t
+    Just t -> pure t
     Nothing ->
       throwDB
         AffectedRowsMismatch

src/Database/PostgreSQL/PQTypes/Format.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Database.PostgreSQL.PQTypes.Format
   ( PQFormat (..)

src/Database/PostgreSQL/PQTypes/FromRow.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Database.PostgreSQL.PQTypes.FromRow
   ( FromRow (..)
   , fromRow'
@@ -78,13 +76,13 @@ instance
         b' = b + fromIntegral (pqVariables @row1)
 
 instance FromRow () where
-  fromRow _ _ _ _ = return ()
+  fromRow _ _ _ _ = pure ()
 
 instance FromSQL t => FromRow (Identity t) where
   fromRow res err b i = withFormat $ \fmt -> alloca $ \p1 -> do
     verify err =<< c_PQgetf1 res err i fmt b p1
     t <- peek p1 >>= convert res i b
-    return (Identity t)
+    pure (Identity t)
 
 instance
   ( FromSQL t1, FromSQL t2

src/Database/PostgreSQL/PQTypes/FromSQL.hs

@@ -39,54 +39,54 @@ instance FromSQL t => FromSQL (Maybe t) where
   type PQBase (Maybe t) = PQBase t
   fromSQL mbase = case mbase of
     Just _ -> Just <$> fromSQL mbase
-    Nothing -> return Nothing
+    Nothing -> pure Nothing
 
 -- NUMERICS
 
 instance FromSQL Int16 where
   type PQBase Int16 = CShort
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just n) = return . fromIntegral $ n
+  fromSQL (Just n) = pure . fromIntegral $ n
 
 instance FromSQL Int32 where
   type PQBase Int32 = CInt
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just n) = return . fromIntegral $ n
+  fromSQL (Just n) = pure . fromIntegral $ n
 
 instance FromSQL Int64 where
   type PQBase Int64 = CLLong
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just n) = return . fromIntegral $ n
+  fromSQL (Just n) = pure . fromIntegral $ n
 
 instance FromSQL Float where
   type PQBase Float = CFloat
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just n) = return . realToFrac $ n
+  fromSQL (Just n) = pure . realToFrac $ n
 
 instance FromSQL Double where
   type PQBase Double = CDouble
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just n) = return . realToFrac $ n
+  fromSQL (Just n) = pure . realToFrac $ n
 
 -- CHAR
 
 instance FromSQL Char where
   type PQBase Char = CChar
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just c) = return . castCCharToChar $ c
+  fromSQL (Just c) = pure . castCCharToChar $ c
 
 instance FromSQL Word8 where
   type PQBase Word8 = CChar
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just c) = return . fromIntegral $ c
+  fromSQL (Just c) = pure . fromIntegral $ c
 
 -- VARIABLE-LENGTH CHARACTER TYPES
 
 -- | Assumes that source C string is UTF-8, so if you are working
 -- with a different encoding, you should not rely on this instance.
 instance FromSQL T.Text where
   type PQBase T.Text = PGbytea
-  fromSQL mbytea = either E.throwIO return . decodeUtf8' =<< fromSQL mbytea
+  fromSQL mbytea = either E.throwIO pure . decodeUtf8' =<< fromSQL mbytea
 
 -- | Assumes that source C string is UTF-8, so if you are working
 -- with a different encoding, you should not rely on this instance
@@ -103,7 +103,7 @@ instance FromSQL String where
 instance FromSQL U.UUID where
   type PQBase U.UUID = PGuuid
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just (PGuuid w1 w2 w3 w4)) = return $ U.fromWords w1 w2 w3 w4
+  fromSQL (Just (PGuuid w1 w2 w3 w4)) = pure $ U.fromWords w1 w2 w3 w4
 
 -- BYTEA
 
@@ -121,21 +121,21 @@ instance FromSQL BSL.ByteString where
 instance FromSQL Day where
   type PQBase Day = PGdate
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just date) = return . pgDateToDay $ date
+  fromSQL (Just date) = pure . pgDateToDay $ date
 
 -- TIME
 
 instance FromSQL TimeOfDay where
   type PQBase TimeOfDay = PGtime
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just time) = return . pgTimeToTimeOfDay $ time
+  fromSQL (Just time) = pure . pgTimeToTimeOfDay $ time
 
 -- TIMESTAMP
 
 instance FromSQL LocalTime where
   type PQBase LocalTime = PGtimestamp
   fromSQL Nothing = unexpectedNULL
-  fromSQL (Just PGtimestamp {..}) = return $ LocalTime day tod
+  fromSQL (Just PGtimestamp {..}) = pure $ LocalTime day tod
     where
       day = pgDateToDay pgTimestampDate
       tod = pgTimeToTimeOfDay pgTimestampTime
@@ -151,7 +151,7 @@ instance FromSQL UTCTime where
   fromSQL jts@(Just PGtimestamp {..}) = do
     localTime <- fromSQL jts
     case rest of
-      0 -> return . localTimeToUTC (minutesToTimeZone mins) $ localTime
+      0 -> pure . localTimeToUTC (minutesToTimeZone mins) $ localTime
       _ -> hpqTypesError $ "Invalid gmtoff: " ++ show gmtoff
     where
       gmtoff = pgTimeGMTOff pgTimestampTime
@@ -163,8 +163,8 @@ instance FromSQL Bool where
   type PQBase Bool = CInt
   fromSQL Nothing = unexpectedNULL
   fromSQL (Just n) = case n of
-    0 -> return False
-    _ -> return True
+    0 -> pure False
+    _ -> pure True
 
 ----------------------------------------