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
-