Gardening code with hlint

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
@@ -16,7 +15,7 @@ C.include "<stdexcept>"
 
 main :: IO ()
 main = Hspec.hspec $ do
-  Hspec.describe "Basic C++" $ do
+  Hspec.describe "Basic C++" $
     Hspec.it "Hello World" $ do
       let x = 3
       [C.block| void {

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

@@ -174,7 +174,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 +280,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 +455,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 +490,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 +507,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 +525,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 +555,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

@@ -21,7 +21,7 @@ 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)
@@ -135,7 +135,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 +146,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

@@ -425,7 +425,7 @@ instance Show SomeEq where
 toSomeEq :: (Eq a, Typeable a) => a -> SomeEq
 toSomeEq x = SomeEq x
 
-fromSomeEq :: (Eq a, Typeable a) => SomeEq -> Maybe a
+fromSomeEq :: Typeable a => SomeEq -> Maybe a
 fromSomeEq (SomeEq x) = cast x
 
 data ParameterType
@@ -523,7 +523,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

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

@@ -3,7 +3,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -117,7 +116,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 +137,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 +168,15 @@ untangleParameterDeclaration P.ParameterDeclaration{..} = do
 untangleDeclarationSpecifiers
   :: [P.DeclarationSpecifier] -> Either UntangleErr (Specifiers, TypeSpecifier)
 untangleDeclarationSpecifiers declSpecs = do
-  let (pStorage, pTySpecs, pTyQuals, pFunSpecs) = flip execState ([], [], [], []) $ do
+  let (pStorage, pTySpecs, pTyQuals, pFunSpecs) = flip execState ([], [], [], []) $
         forM_ (reverse declSpecs) $ \declSpec -> case declSpec of
           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 +220,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
@@ -235,7 +235,7 @@ cIdentStart = ['a'..'z'] ++ ['A'..'Z'] ++ ['_']
 cIdentLetter :: [Char]
 cIdentLetter = ['a'..'z'] ++ ['A'..'Z'] ++ ['_'] ++ ['0'..'9']
 
-cIdentStyle :: (TokenParsing m, Monad m) => IdentifierStyle m
+cIdentStyle :: TokenParsing m => IdentifierStyle m
 cIdentStyle = IdentifierStyle
   { _styleName = "C identifier"
   , _styleStart = oneOf cIdentStart
@@ -376,7 +376,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 +424,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 +539,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)