Gardening code with hlint

.hlint.yaml

@@ -0,0 +1,60 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# This file contains a template configuration file, which is typically
+# placed as .hlint.yaml in the root of your project
+
+
+# Specify additional command line arguments
+#
+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
+
+
+# Control which extensions/flags/modules/functions can be used
+#
+# - extensions:
+#   - default: false # all extension are banned by default
+#   - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
+#   - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
+#
+# - flags:
+#   - {name: -w, within: []} # -w is allowed nowhere
+#
+# - modules:
+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
+#
+# - functions:
+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
+
+
+# Add custom hints for this project
+#
+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
+
+
+# Turn on hints that are off by default
+#
+# Ban "module X(module X) where", to require a real export list
+# - warn: {name: Use explicit module export list}
+#
+# Replace a $ b $ c with a . b $ c
+# - group: {name: dollar, enabled: true}
+#
+# Generalise map to fmap, ++ to <>
+# - group: {name: generalise, enabled: true}
+
+
+# Ignore some builtin hints
+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
+- ignore: {name: Use camelCase}
+
+
+# Define some custom infix operators
+# - fixity: infixr 3 ~^#^~
+
+
+# To generate a suitable file for HLint do:
+# $ hlint --default > .hlint.yaml

.travis.yml

@@ -13,11 +13,8 @@ addons:
     - libcairo2-dev
 
 env:
-- ARGS="--flag inline-c:gsl-example"
-- ARGS="--stack-yaml stack-lts-12.14.yaml --flag inline-c:gsl-example"
-# gtk2hs-buildtools is not present in nightly a bit of a pain to install,
-# skip it for now
-- ARGS="--stack-yaml stack-nightly-2018-10-24.yaml"
+- STACK="stack --no-terminal --install-ghc"
+  STACK_TEST="$STACK test --haddock"
 
 before_install:
 # Download and unpack the stack executable
@@ -28,7 +25,21 @@ before_install:
 # This line does all of the work: installs GHC if necessary, build the library,
 # executables, and test suites, and runs the test suites. --no-terminal works
 # around some quirks in Travis's terminal implementation.
-script: stack --no-terminal --install-ghc test --haddock $ARGS
+matrix:
+  include:
+    - name: test +gsl
+      script: $STACK_TEST --flag inline-c:gsl-example
+    - name: test +gsl lts-12.14
+      script:
+        $STACK_TEST
+          --stack-yaml stack-lts-12.14.yaml --flag inline-c:gsl-example
+    - name: test nightly
+      # gtk2hs-buildtools is not present in nightly a bit of a pain to install,
+      # skip it for now
+      script: $STACK_TEST --stack-yaml stack-nightly-2018-10-24.yaml
+    - name: HLint
+      # 2.1.11 inroduced {- HLINT -} pragmas, use it until lts-12.22
+      script: $STACK build hlint-2.1.11 --exec 'hlint .'
 
 # Caching so the next build will be fast too.
 cache:

inline-c-cpp/src/Language/C/Inline/Cpp/Exceptions.hs

@@ -70,7 +70,7 @@ handleForeignCatch cont =
 -- them in an 'Either'
 throwBlock :: QuasiQuoter
 throwBlock = QuasiQuoter
-  { quoteExp = \blockStr -> do
+  { quoteExp = \blockStr ->
       [e| either throwIO return =<< $(tryBlockQuoteExp blockStr) |]
   , quotePat = unsupported
   , quoteType = unsupported
@@ -87,7 +87,7 @@ catchBlock = QuasiQuoter
   , quoteDec = unsupported
   } where
       unsupported _ = fail "Unsupported quasiquotation."
-      
+
 
 tryBlockQuoteExp :: String -> Q Exp
 tryBlockQuoteExp blockStr = do
@@ -147,7 +147,7 @@ tryBlockQuoteExp blockStr = do
         , "}"
         ]
   [e| handleForeignCatch $ \ $(varP typePtrVarName) $(varP msgPtrVarName) -> $(quoteExp C.block inlineCStr) |]
- 
+
 -- | Similar to `C.block`, but C++ exceptions will be caught and the result is (Either CppException value). The return type must be void or constructible with @{}@.
 -- Using this will automatically include @exception@, @cstring@ and @cstdlib@.
 tryBlock :: QuasiQuoter

inline-c-cpp/test/tests.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import           Control.Exception.Safe
-import           Control.Monad
 import qualified Language.C.Inline.Cpp as C
 import qualified Language.C.Inline.Cpp.Exceptions as C
 import qualified Test.Hspec as Hspec
@@ -129,3 +128,5 @@ main = Hspec.hspec $ do
         |]
 
       result `Hspec.shouldBe` Right 0xDEADBEEF
+
+{- HLINT ignore main "Redundant do" -}

inline-c/examples/gsl-ode.hs

@@ -104,7 +104,7 @@ lorenz
   -> Double
   -- ^ End point
   -> Either String (V.Vector Double)
-lorenz x0 f0 xend = solveOde fun x0 f0 xend
+lorenz = solveOde fun
   where
     sigma = 10.0;
     _R = 28.0;

inline-c/src/Language/C/Inline.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -315,7 +312,7 @@ verbatim s = do
 -- | Like 'alloca', but also peeks the contents of the 'Ptr' and returns
 -- them once the provided action has finished.
 withPtr :: (Storable a) => (Ptr a -> IO b) -> IO (a, b)
-withPtr f = do
+withPtr f =
   alloca $ \ptr -> do
     x <- f ptr
     y <- peek ptr

inline-c/src/Language/C/Inline/Context.hs

@@ -42,6 +42,9 @@ module Language.C.Inline.Context
   , bsCtx
   ) where
 
+{- HLINT ignore "Use fewer imports" -}
+{- HLINT ignore "Reduce duplication" -}
+
 import           Control.Applicative ((<|>))
 import           Control.Monad (mzero)
 import           Control.Monad.Trans.Class (lift)
@@ -174,7 +177,9 @@ instance Monoid Context where
     , ctxForeignSrcLang = Nothing
     }
 
-#if !MIN_VERSION_base(4,11,0)
+#if MIN_VERSION_base(4,9,0)
+  mappend = (<>)
+#else
   mappend ctx2 ctx1 = Context
     { ctxTypesTable = ctxTypesTable ctx1 <> ctxTypesTable ctx2
     , ctxAntiQuoters = ctxAntiQuoters ctx1 <> ctxAntiQuoters ctx2
@@ -278,7 +283,7 @@ convertType purity cTypes = runMaybeT . go
       C.Array _mbSize cTy' -> do
         hsTy <- go cTy'
         lift [t| CArray $(return hsTy) |]
-      C.Proto _retType _pars -> do
+      C.Proto _retType _pars ->
         -- We cannot convert standalone prototypes
         mzero
 
@@ -453,15 +458,15 @@ vecLenAntiQuoter = AntiQuoter
       hId <- C.parseIdentifier
       let cId = mangleHaskellIdentifier hId
       return (cId, C.TypeSpecifier mempty (C.Long C.Signed), hId)
-  , aqMarshaller = \_purity _cTypes cTy cId -> do
+  , aqMarshaller = \_purity _cTypes cTy cId ->
       case cTy of
         C.TypeSpecifier _ (C.Long C.Signed) -> do
           hsExp <- getHsVariable "vecCtx" cId
           hsExp' <- [| fromIntegral (vecCtxLength $(return hsExp)) |]
           hsTy <- [t| CLong |]
           hsExp'' <- [| \cont -> cont $(return hsExp') |]
           return (hsTy, hsExp'')
-        _ -> do
+        _ ->
           fail "impossible: got type different from `long' (vecCtx)"
   }
 
@@ -488,7 +493,7 @@ bsPtrAntiQuoter = AntiQuoter
       hId <- C.parseIdentifier
       let cId = mangleHaskellIdentifier hId
       return (cId, C.Ptr [] (C.TypeSpecifier mempty (C.Char Nothing)), hId)
-  , aqMarshaller = \_purity _cTypes cTy cId -> do
+  , aqMarshaller = \_purity _cTypes cTy cId ->
       case cTy of
         C.Ptr _ (C.TypeSpecifier _ (C.Char Nothing)) -> do
           hsTy <- [t| Ptr CChar |]
@@ -505,15 +510,15 @@ bsLenAntiQuoter = AntiQuoter
       hId <- C.parseIdentifier
       let cId = mangleHaskellIdentifier hId
       return (cId, C.TypeSpecifier mempty (C.Long C.Signed), hId)
-  , aqMarshaller = \_purity _cTypes cTy cId -> do
+  , aqMarshaller = \_purity _cTypes cTy cId ->
       case cTy of
         C.TypeSpecifier _ (C.Long C.Signed) -> do
           hsExp <- getHsVariable "bsCtx" cId
           hsExp' <- [| fromIntegral (BS.length $(return hsExp)) |]
           hsTy <- [t| CLong |]
           hsExp'' <- [| \cont -> cont $(return hsExp') |]
           return (hsTy, hsExp'')
-        _ -> do
+        _ ->
           fail "impossible: got type different from `long' (bsCtx)"
   }
 
@@ -523,7 +528,7 @@ bsCStrAntiQuoter = AntiQuoter
       hId <- C.parseIdentifier
       let cId = mangleHaskellIdentifier hId
       return (cId, C.Ptr [] (C.TypeSpecifier mempty (C.Char Nothing)), hId)
-  , aqMarshaller = \_purity _cTypes cTy cId -> do
+  , aqMarshaller = \_purity _cTypes cTy cId ->
       case cTy of
         C.Ptr _ (C.TypeSpecifier _ (C.Char Nothing)) -> do
           hsTy <- [t| Ptr CChar |]
@@ -553,7 +558,7 @@ cDeclAqParser = do
 deHaskellifyCType
   :: C.CParser HaskellIdentifier m
   => C.Type HaskellIdentifier -> m (C.Type C.CIdentifier)
-deHaskellifyCType = traverse $ \hId -> do
+deHaskellifyCType = traverse $ \hId ->
   case C.cIdentifierFromString (unHaskellIdentifier hId) of
     Left err -> fail $ "Illegal Haskell identifier " ++ unHaskellIdentifier hId ++
                        " in C type:\n" ++ err

inline-c/src/Language/C/Inline/HaskellIdentifier.hs

@@ -16,12 +16,14 @@ module Language.C.Inline.HaskellIdentifier
   , haskellReservedWords
   ) where
 
+{- HLINT ignore "Use fewer imports" -}
+
 import           Control.Applicative ((<|>))
 import           Control.Monad (when, msum, void)
 import           Data.Char (ord)
 import qualified Data.HashSet as HashSet
 import           Data.Hashable (Hashable)
-import           Data.List (intercalate, partition, intersperse)
+import           Data.List (intercalate, partition)
 import           Data.Monoid ((<>))
 import           Data.String (IsString(..))
 import           Data.Typeable (Typeable)
@@ -94,9 +96,8 @@ haskellReservedWords = C.cReservedWords <> HashSet.fromList
 -- | See
 -- <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-160002.2>.
 parseHaskellIdentifier :: forall i m. C.CParser i m => m HaskellIdentifier
-parseHaskellIdentifier = do
-  segments <- go
-  return $ HaskellIdentifier $ intercalate "." segments
+parseHaskellIdentifier =
+  HaskellIdentifier . intercalate "." <$> go
   where
     small = lower <|> char '_'
     large = upper
@@ -135,7 +136,7 @@ mangleHaskellIdentifier (HaskellIdentifier hs) =
   where
     (valid, invalid) = partition (`elem` C.cIdentLetter) hs
 
-    mangled = concat $ intersperse "_" $ map (`showHex` "") $ map ord invalid
+    mangled = intercalate "_" $ map ((`showHex` "") . ord) invalid
 
 -- Utils
 ------------------------------------------------------------------------
@@ -146,4 +147,3 @@ identNoLex s = fmap fromString $ try $ do
           ((:) <$> _styleStart s <*> many (_styleLetter s) <?> _styleName s)
   when (HashSet.member name (_styleReserved s)) $ unexpected $ "reserved " ++ _styleName s ++ " " ++ show name
   return name
-

inline-c/src/Language/C/Inline/Internal.hs

@@ -199,7 +199,7 @@ setContext ctx = do
   void $ initialiseModuleState $ Just ctx
 
 bumpGeneratedNames :: TH.Q Int
-bumpGeneratedNames = do
+bumpGeneratedNames =
   modifyModuleState $ \ms ->
     let c' = msGeneratedNames ms
     in (ms{msGeneratedNames = c' + 1}, c')
@@ -406,10 +406,10 @@ runParserInQ s ctx p = do
   let parsecLoc = Parsec.newPos (TH.loc_filename loc) line col
   let p' = lift (Parsec.setPosition parsecLoc) *> p <* lift Parser.eof
   case C.runCParser ctx (TH.loc_filename loc) s p' of
-    Left err -> do
+    Left err ->
       -- TODO consider prefixing with "error while parsing C" or similar
       fail $ show err
-    Right res -> do
+    Right res ->
       return res
 
 data SomeEq = forall a. (Typeable a, Eq a) => SomeEq a
@@ -423,9 +423,9 @@ instance Show SomeEq where
   show _ = "<<SomeEq>>"
 
 toSomeEq :: (Eq a, Typeable a) => a -> SomeEq
-toSomeEq x = SomeEq x
+toSomeEq = SomeEq
 
-fromSomeEq :: (Eq a, Typeable a) => SomeEq -> Maybe a
+fromSomeEq :: Typeable a => SomeEq -> Maybe a
 fromSomeEq (SomeEq x) = cast x
 
 data ParameterType
@@ -481,7 +481,6 @@ parseTypedC antiQs = do
              return (decls1 ++ decls2, s1 ++ s2)
         ]
       return (decls, s ++ s')
-      where
 
     parseAntiQuote
       :: StateT Int m ([(C.CIdentifier, C.Type C.CIdentifier, ParameterType)], String)
@@ -523,7 +522,7 @@ parseTypedC antiQs = do
     -- The @m@ is polymorphic because we use this both for the plain
     -- parser and the StateT parser we use above.  We only need 'fail'.
     purgeHaskellIdentifiers
-      :: forall n. (Applicative n, Monad n)
+      :: forall n. Monad n
       => C.Type HaskellIdentifier -> n (C.Type C.CIdentifier)
     purgeHaskellIdentifiers cTy = for cTy $ \hsIdent -> do
       let hsIdentS = unHaskellIdentifier hsIdent
@@ -557,14 +556,14 @@ genericQuote purity build = quoteCode $ \s -> do
         (haskellCParserContext (typeNamesFromTypesTable (ctxTypesTable ctx)))
         (parseTypedC (ctxAntiQuoters ctx))
     hsType <- cToHs ctx cType
-    hsParams <- forM cParams $ \(_cId, cTy, parTy) -> do
+    hsParams <- forM cParams $ \(_cId, cTy, parTy) ->
       case parTy of
         Plain s' -> do
           hsTy <- cToHs ctx cTy
           let hsName = TH.mkName (unHaskellIdentifier s')
           hsExp <- [| \cont -> cont ($(TH.varE hsName) :: $(return hsTy)) |]
           return (hsTy, hsExp)
-        AntiQuote antiId dyn -> do
+        AntiQuote antiId dyn ->
           case Map.lookup antiId (ctxAntiQuoters ctx) of
             Nothing ->
               fail $ "IMPOSSIBLE: could not find anti-quoter " ++ show antiId ++
@@ -599,13 +598,9 @@ genericQuote purity build = quoteCode $ \s -> do
        |]
 
     convertCFunSig :: TH.Type -> [TH.Type] -> TH.TypeQ
-    convertCFunSig retType params0 = do
-      go params0
-      where
-        go [] =
-          [t| IO $(return retType) |]
-        go (paramType : params) = do
-          [t| $(return paramType) -> $(go params) |]
+    convertCFunSig retType = go where
+      go []                   = [t| IO $(return retType) |]
+      go (paramType : params) = [t| $(return paramType) -> $(go params) |]
 
 splitTypedC :: String -> (String, String)
   -- ^ Returns the type and the body separately
@@ -640,13 +635,9 @@ funPtrQuote callSafety = quoteCode $ \code -> do
         Just hsTy -> return hsTy
 
     convertCFunSig :: TH.Type -> [TH.Type] -> TH.TypeQ
-    convertCFunSig retType params0 = do
-      go params0
-      where
-        go [] =
-          [t| IO $(return retType) |]
-        go (paramType : params) = do
-          [t| $(return paramType) -> $(go params) |]
+    convertCFunSig retType = go where
+      go []                   = [t| IO $(return retType) |]
+      go (paramType : params) = [t| $(return paramType) -> $(go params) |]
 
     parse :: C.CParser C.CIdentifier m => m FunPtrDecl
     parse = do
@@ -669,7 +660,7 @@ funPtrQuote callSafety = quoteCode $ \code -> do
             , funPtrBody = body
             , funPtrName = fmap C.unCIdentifier mbName
             }
-        _ -> fail $ "Expecting function declaration"
+        _ -> fail "Expecting function declaration"
 
     parseBody :: C.CParser C.CIdentifier m => m String
     parseBody = do

inline-c/src/Language/C/Types.hs

@@ -3,10 +3,10 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -60,6 +60,8 @@ module Language.C.Types
   , describeType
   ) where
 
+{- HLINT ignore "Use fewer imports" -}
+
 import           Control.Arrow (second)
 import           Control.Monad (when, unless, forM_)
 import           Control.Monad.State (execState, modify)
@@ -117,7 +119,9 @@ instance Semigroup Specifiers where
 instance Monoid Specifiers where
   mempty = Specifiers [] [] []
 
-#if !MIN_VERSION_base(4,11,0)
+#if MIN_VERSION_base(4,9,0)
+  mappend = (<>)
+#else
   mappend (Specifiers x1 y1 z1) (Specifiers x2 y2 z2) =
     Specifiers (x1 ++ x2) (y1 ++ y2) (z1 ++ z2)
 #endif
@@ -136,7 +140,7 @@ data Sign
 
 data ParameterDeclaration i = ParameterDeclaration
   { parameterDeclarationId :: Maybe i
-  , parameterDeclarationType :: (Type i)
+  , parameterDeclarationType :: Type i
   } deriving (Typeable, Show, Eq, Functor, Foldable, Traversable)
 
 ------------------------------------------------------------------------
@@ -167,15 +171,15 @@ untangleParameterDeclaration P.ParameterDeclaration{..} = do
 untangleDeclarationSpecifiers
   :: [P.DeclarationSpecifier] -> Either UntangleErr (Specifiers, TypeSpecifier)
 untangleDeclarationSpecifiers declSpecs = do
-  let (pStorage, pTySpecs, pTyQuals, pFunSpecs) = flip execState ([], [], [], []) $ do
-        forM_ (reverse declSpecs) $ \declSpec -> case declSpec of
+  let (pStorage, pTySpecs, pTyQuals, pFunSpecs) = flip execState ([], [], [], []) $
+        forM_ (reverse declSpecs) $ \case
           P.StorageClassSpecifier x -> modify $ \(a, b, c, d) -> (x:a, b, c, d)
           P.TypeSpecifier x -> modify $ \(a, b, c, d) -> (a, x:b, c, d)
           P.TypeQualifier x -> modify $ \(a, b, c, d) -> (a, b, x:c, d)
           P.FunctionSpecifier x -> modify $ \(a, b, c, d) -> (a, b, c, x:d)
   -- Split data type and specifiers
   let (dataTypes, specs) =
-        partition (\x -> not (x `elem` [P.SIGNED, P.UNSIGNED, P.LONG, P.SHORT])) pTySpecs
+        partition (`notElem` [P.SIGNED, P.UNSIGNED, P.LONG, P.SHORT]) pTySpecs
   let illegalSpecifiers s = failConversion $ IllegalSpecifiers s specs
   -- Find out sign, if present
   mbSign0 <- case filter (== P.SIGNED) specs of
@@ -219,26 +223,26 @@ untangleDeclarationSpecifiers declSpecs = do
     P.CHAR -> do
       checkNoLength
       return $ Char mbSign
-    P.INT | longs == 0 && shorts == 0 -> do
+    P.INT | longs == 0 && shorts == 0 ->
       return $ Int sign
-    P.INT | longs == 1 -> do
+    P.INT | longs == 1 ->
       return $ Long sign
-    P.INT | longs == 2 -> do
+    P.INT | longs == 2 ->
       return $ LLong sign
-    P.INT | shorts == 1 -> do
+    P.INT | shorts == 1 ->
       return $ Short sign
-    P.INT -> do
+    P.INT ->
       illegalSpecifiers "too many long/short"
     P.FLOAT -> do
       checkNoLength
       return Float
-    P.DOUBLE -> do
+    P.DOUBLE ->
       if longs == 1
         then return LDouble
         else do
           checkNoLength
           return Double
-    _ -> do
+    _ ->
       error $ "untangleDeclarationSpecifiers impossible: " ++ show dataType
   return (Specifiers pStorage pTyQuals pFunSpecs, tySpec)
 

inline-c/src/Language/C/Types/Parse.hs

@@ -186,7 +186,7 @@ runCParser
   -- ^ Source name.
   -> s
   -- ^ String to parse.
-  -> (ReaderT (CParserContext i) (Parsec.Parsec s ()) a)
+  -> ReaderT (CParserContext i) (Parsec.Parsec s ()) a
   -- ^ Parser.  Anything with type @forall m. CParser i m => m a@ is a
   -- valid argument.
   -> Either Parsec.ParseError a
@@ -198,7 +198,7 @@ quickCParser
   :: CParserContext i
   -> String
   -- ^ String to parse.
-  -> (ReaderT (CParserContext i) (Parsec.Parsec String ()) a)
+  -> ReaderT (CParserContext i) (Parsec.Parsec String ()) a
   -- ^ Parser.  Anything with type @forall m. CParser i m => m a@ is a
   -- valid argument.
   -> a
@@ -211,7 +211,7 @@ quickCParser typeNames s p = case runCParser typeNames "quickCParser" s p of
 quickCParser_
   :: String
   -- ^ String to parse.
-  -> (ReaderT (CParserContext CIdentifier) (Parsec.Parsec String ()) a)
+  -> ReaderT (CParserContext CIdentifier) (Parsec.Parsec String ()) a
   -- ^ Parser.  Anything with type @forall m. CParser i m => m a@ is a
   -- valid argument.
   -> a
@@ -231,11 +231,13 @@ cReservedWords = HashSet.fromList
 
 cIdentStart :: [Char]
 cIdentStart = ['a'..'z'] ++ ['A'..'Z'] ++ ['_']
+{- HLINT ignore cIdentStart "Use String" -}
 
 cIdentLetter :: [Char]
 cIdentLetter = ['a'..'z'] ++ ['A'..'Z'] ++ ['_'] ++ ['0'..'9']
+{- HLINT ignore cIdentLetter "Use String" -}
 
-cIdentStyle :: (TokenParsing m, Monad m) => IdentifierStyle m
+cIdentStyle :: TokenParsing m => IdentifierStyle m
 cIdentStyle = IdentifierStyle
   { _styleName = "C identifier"
   , _styleStart = oneOf cIdentStart
@@ -376,7 +378,7 @@ function_specifier = msum
 
 data Declarator i = Declarator
   { declaratorPointers :: [Pointer]
-  , declaratorDirect :: (DirectDeclarator i)
+  , declaratorDirect :: DirectDeclarator i
   } deriving (Typeable, Eq, Show, Functor, Foldable, Traversable)
 
 declarator :: CParser i m => m (Declarator i)
@@ -424,7 +426,7 @@ direct_declarator = do
   aops <- many array_or_proto
   return $ foldl ArrayOrProto ddecltor aops
 
-data Pointer
+newtype Pointer
   = Pointer [TypeQualifier]
   deriving (Typeable, Eq, Show)
 
@@ -539,8 +541,7 @@ instance Pretty i => Pretty (Declarator i) where
     _:_ -> prettyPointers ptrs <+> pretty ddecltor
 
 prettyPointers :: [Pointer] -> Doc
-prettyPointers [] = ""
-prettyPointers (x : xs) = pretty x <> prettyPointers xs
+prettyPointers = foldr ((<>) . pretty) ""
 
 instance Pretty Pointer where
   pretty (Pointer tyQual) = "*" <> hsep (map pretty tyQual)

inline-c/test/Language/C/Inline/ContextSpec.hs

@@ -81,7 +81,7 @@ spec = do
     goodConvert cTy = do
       mbHsTy <- TH.runQ $ convertType IO baseTypes cTy
       case mbHsTy of
-        Nothing   -> error $ "Could not convert type (goodConvert)"
+        Nothing   -> error "Could not convert type (goodConvert)"
         Just hsTy -> return hsTy
 
     shouldBeType cTy hsTy = do
@@ -97,3 +97,5 @@ spec = do
     cty s = C.parameterDeclarationType $ assertParse C.parseParameterDeclaration s
 
     baseTypes = ctxTypesTable baseCtx
+
+{- HLINT ignore spec "Redundant do" -}

inline-c/test/Language/C/Inline/ParseSpec.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Language.C.Inline.ParseSpec (spec) where
 
@@ -36,7 +35,7 @@ spec = do
       (retType, params, cExp) <- goodParse [r|
           int { (int) ceil($(double x) + ((double) $(float y))) }
         |]
-      retType `Hspec.shouldBe` (cty "int")
+      retType `Hspec.shouldBe` cty "int"
       params `shouldMatchParameters` [(cty "double", Plain "x"), (cty "float", Plain "y")]
       cExp `shouldMatchBody` " (int) ceil(x[a-z0-9_]+ \\+ ((double) y[a-z0-9_]+)) "
     Hspec.it "accepts anti quotes" $ do
@@ -50,22 +49,22 @@ spec = do
     Hspec.it "parses returning function pointers" $ do
       (retType, params, cExp) <-
         goodParse [r| double (*)(double) { &cos } |]
-      retType `Hspec.shouldBe` (cty "double (*)(double)")
+      retType `Hspec.shouldBe` cty "double (*)(double)"
       params `shouldMatchParameters` []
       cExp `shouldMatchBody` " &cos "
     Hspec.it "parses Haskell identifier (1)" $ do
       (retType, params, cExp) <- goodParse [r| double { $(double x') } |]
-      retType `Hspec.shouldBe` (cty "double")
+      retType `Hspec.shouldBe` cty "double"
       params `shouldMatchParameters` [(cty "double", Plain "x'")]
       cExp `shouldMatchBody` " x[a-z0-9_]+ "
     Hspec.it "parses Haskell identifier (2)" $ do
       (retType, params, cExp) <- goodParse [r| double { $(double ä') } |]
-      retType `Hspec.shouldBe` (cty "double")
+      retType `Hspec.shouldBe` cty "double"
       params `shouldMatchParameters` [(cty "double", Plain "ä'")]
       cExp `shouldMatchBody` " [a-z0-9_]+ "
     Hspec.it "parses Haskell identifier (3)" $ do
       (retType, params, cExp) <- goodParse [r| int { $(int Foo.bar) } |]
-      retType `Hspec.shouldBe` (cty "int")
+      retType `Hspec.shouldBe` cty "int"
       params `shouldMatchParameters` [(cty "int", Plain "Foo.bar")]
       cExp `shouldMatchBody` " Foobar[a-z0-9_]+ "
     Hspec.it "does not parse Haskell identifier in bad position" $ do
@@ -110,3 +109,5 @@ spec = do
             ')' -> "\\)"
             ch -> [ch]
       (x =~ concatMap f y) `Hspec.shouldBe` True
+
+{- HLINT ignore spec "Redundant do" -}

inline-c/test/Language/C/Types/ParseSpec.hs

@@ -51,6 +51,7 @@ spec = do
       return $ isGoodType ty QC.==>
         let ty' = assertParse (haskellCParserContext typeNames) parameter_declaration (prettyOneLine ty)
         in Types.untangleParameterDeclaration ty == Types.untangleParameterDeclaration ty'
+{- HLINT ignore spec "Redundant do" -}
 
 ------------------------------------------------------------------------
 -- Utils
@@ -92,7 +93,7 @@ halveSize m = QC.sized $ \n -> QC.resize (n `div` 2) m
 
 instance QC.Arbitrary CIdentifier where
   arbitrary = do
-    s <- ((:) <$> QC.elements cIdentStart <*> QC.listOf (QC.elements cIdentLetter))
+    s <- (:) <$> QC.elements cIdentStart <*> QC.listOf (QC.elements cIdentLetter)
     if HashSet.member s cReservedWords
       then QC.arbitrary
       else return $ fromString s
@@ -101,7 +102,7 @@ instance QC.Arbitrary CIdentifier where
 -- arbitrary allowed type names.
 data ParameterDeclarationWithTypeNames i = ParameterDeclarationWithTypeNames
   { _pdwtnTypeNames :: HashSet.HashSet CIdentifier
-  , _pdwtnParameterDeclaration :: (ParameterDeclaration i)
+  , _pdwtnParameterDeclaration :: ParameterDeclaration i
   } deriving (Typeable, Eq, Show)
 
 data ArbitraryContext i = ArbitraryContext
@@ -120,8 +121,8 @@ arbitraryParameterDeclarationWithTypeNames identToString = do
     return $ ParameterDeclarationWithTypeNames names decl
 
 arbitraryDeclarationSpecifierFrom
-  :: (QC.Arbitrary i, Hashable i) => ArbitraryContext i -> QC.Gen DeclarationSpecifier
-arbitraryDeclarationSpecifierFrom typeNames = QC.oneof $
+  :: ArbitraryContext i -> QC.Gen DeclarationSpecifier
+arbitraryDeclarationSpecifierFrom typeNames = QC.oneof
   [ StorageClassSpecifier <$> QC.arbitrary
   , TypeQualifier <$> QC.arbitrary
   , FunctionSpecifier <$> QC.arbitrary
@@ -137,7 +138,7 @@ instance QC.Arbitrary StorageClassSpecifier where
     , return REGISTER
     ]
 
-arbitraryTypeSpecifierFrom :: (Hashable i, QC.Arbitrary i) => ArbitraryContext i -> QC.Gen TypeSpecifier
+arbitraryTypeSpecifierFrom :: ArbitraryContext i -> QC.Gen TypeSpecifier
 arbitraryTypeSpecifierFrom ctx = QC.oneof $
   [ return VOID
   , return CHAR
@@ -170,8 +171,7 @@ arbitraryDeclaratorFrom
 arbitraryDeclaratorFrom typeNames = halveSize $
   Declarator <$> QC.arbitrary <*> arbitraryDirectDeclaratorFrom typeNames
 
-arbitraryCIdentifierFrom
-  :: (Hashable i, QC.Arbitrary i) => ArbitraryContext i -> QC.Gen CIdentifier
+arbitraryCIdentifierFrom :: ArbitraryContext i -> QC.Gen CIdentifier
 arbitraryCIdentifierFrom ctx =
   arbitraryIdentifierFrom ctx{acIdentToString = unCIdentifier}
 
@@ -185,7 +185,7 @@ arbitraryIdentifierFrom ctx = do
 
 arbitraryDirectDeclaratorFrom
   :: (Hashable i, QC.Arbitrary i) => ArbitraryContext i -> QC.Gen (DirectDeclarator i)
-arbitraryDirectDeclaratorFrom typeNames = halveSize $ oneOfSized $
+arbitraryDirectDeclaratorFrom typeNames = halveSize $ oneOfSized
   [ Anyhow $ DeclaratorRoot <$> arbitraryIdentifierFrom typeNames
   , IfPositive $ DeclaratorParens <$> arbitraryDeclaratorFrom typeNames
   , IfPositive $ ArrayOrProto
@@ -195,7 +195,7 @@ arbitraryDirectDeclaratorFrom typeNames = halveSize $ oneOfSized $
 
 arbitraryArrayOrProtoFrom
   :: (Hashable i, QC.Arbitrary i) => ArbitraryContext i -> QC.Gen (ArrayOrProto i)
-arbitraryArrayOrProtoFrom typeNames = halveSize $ oneOfSized $
+arbitraryArrayOrProtoFrom typeNames = halveSize $ oneOfSized
   [ Anyhow $ Array <$> arbitraryArrayTypeFrom typeNames
   , IfPositive $ Proto <$> QC.listOf (arbitraryParameterDeclarationFrom typeNames)
   ]
@@ -235,7 +235,7 @@ arbitraryAbstractDeclaratorFrom typeNames = halveSize $ do
 
 arbitraryDirectAbstractDeclaratorFrom
   :: (Hashable i, QC.Arbitrary i) => ArbitraryContext i -> QC.Gen (DirectAbstractDeclarator i)
-arbitraryDirectAbstractDeclaratorFrom typeNames = halveSize $ oneOfSized $
+arbitraryDirectAbstractDeclaratorFrom typeNames = halveSize $ oneOfSized
   [ Anyhow $ ArrayOrProtoHere <$> arbitraryArrayOrProtoFrom typeNames
   , IfPositive $ AbstractDeclaratorParens <$> arbitraryAbstractDeclaratorFrom typeNames
   , IfPositive $ ArrayOrProtoThere
@@ -254,10 +254,10 @@ instance QC.Arbitrary HaskellIdentifier where
       arbitraryModId = arbitraryConId
 
       arbitraryConId =
-        ((:) <$> QC.elements large <*> QC.listOf (QC.elements (small ++ large ++ digit' ++ ['\''])))
+        (:) <$> QC.elements large <*> QC.listOf (QC.elements (small ++ large ++ digit' ++ ['\'']))
 
       arbitraryVarId =
-        ((:) <$> QC.elements small <*> QC.listOf (QC.elements (small ++ large ++ digit' ++ ['\''])))
+        (:) <$> QC.elements small <*> QC.listOf (QC.elements (small ++ large ++ digit' ++ ['\'']))
 
       -- We currently do not generate unicode identifiers.
       large = ['A'..'Z']

inline-c/test/tests.hs

@@ -205,14 +205,16 @@ main = Hspec.hspec $ do
       bits `Hspec.shouldBe` 16
     Hspec.it "Haskell identifiers" $ do
       let x' = 3
-      void $ [C.exp| int { $(int x') } |]
+      void [C.exp| int { $(int x') } |]
       let ä = 3
-      void $ [C.exp| int { $(int ä) } |]
-      void $ [C.exp| int { $(int Prelude.maxBound) } |]
+      void [C.exp| int { $(int ä) } |]
+      void [C.exp| int { $(int Prelude.maxBound) } |]
     Hspec.it "Function pointers" $ do
       alloca $ \x_ptr -> do
         poke x_ptr 7
         let fp = [C.funPtr| void poke42(int *ptr) { *ptr = 42; } |]
         [C.exp| void { $(void (*fp)(int *))($(int *x_ptr)) } |]
         x <- peek x_ptr
         x `Hspec.shouldBe` 42
+
+{- HLINT ignore main "Redundant do" -}