Merge pull request #528 from bos/hlint

bergmark · web-flow · commit 4861d65f63b9 · 2017-03-25T17:30:49.000+01:00
Hlinting
diff --git a/.travis.yml b/.travis.yml
@@ -19,6 +19,9 @@ before_cache:
 
 matrix:
   include:
+    - env: BUILD=hlint CABALVER=1.24 GHCVER=8.0.2
+      compiler: ": #GHC 8.0.2"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}
     - env: BUILD=stack CABALVER=1.24 GHCVER=8.0.2 STACK_YAML=stack-bench.yaml
       compiler: ": #GHC 8.0.2"
       addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}
diff --git a/Data/Aeson/Encoding/Builder.hs b/Data/Aeson/Encoding/Builder.hs
@@ -292,7 +292,7 @@ encodeUtf8BuilderEscaped be =
       where
         iend = off + len
 
-        outerLoop !i0 !br@(B.BufferRange op0 ope)
+        outerLoop !i0 br@(B.BufferRange op0 ope)
           | i0 >= iend       = k br
           | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
           -- TODO: Use a loop with an integrated bound's check if outRemaining
diff --git a/Data/Aeson/Internal/Time.hs b/Data/Aeson/Internal/Time.hs
@@ -20,14 +20,13 @@ module Data.Aeson.Internal.Time
 import Prelude ()
 import Prelude.Compat
 
-import Data.Fixed (Pico)
 import Data.Int (Int64)
 import Data.Time
 import Unsafe.Coerce (unsafeCoerce)
 
 #if MIN_VERSION_base(4,7,0)
 
-import Data.Fixed (Fixed(MkFixed))
+import Data.Fixed (Pico, Fixed(MkFixed))
 
 toPico :: Integer -> Pico
 toPico = MkFixed
@@ -37,6 +36,8 @@ fromPico (MkFixed i) = i
 
 #else
 
+import Data.Fixed (Pico)
+
 toPico :: Integer -> Pico
 toPico = unsafeCoerce
 
diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs
@@ -221,6 +221,8 @@ jstring_ = {-# SCC "jstring_" #-} do
                     in Just (S a')
 
 data S = S Int#
+-- This hint will no longer trigger once hlint > 1.9.41 is released.
+{-# ANN S ("HLint: ignore Use newtype instead of data" :: String) #-}
 #else
     startState              = False
     go a c
diff --git a/Data/Aeson/TH.hs b/Data/Aeson/TH.hs
@@ -1629,7 +1629,7 @@ buildTypeInstanceFromTys tyConName jc dataCxt varTysOrig isDataFamily = do
         --   instance C (Fam [Char])
         remainingTysOrigSubst :: [Type]
         remainingTysOrigSubst =
-          map (substNamesWithKindStar (union droppedKindVarNames kvNames'))
+          map (substNamesWithKindStar (droppedKindVarNames `union` kvNames'))
             $ take remainingLength varTysOrig
 
         remainingTysOrigSubst' :: [Type]
@@ -2118,7 +2118,7 @@ createKindChain :: Int -> Kind
 createKindChain = go starK
   where
     go :: Kind -> Int -> Kind
-    go k !0 = k
+    go k 0 = k
 #if MIN_VERSION_template_haskell(2,8,0)
     go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1)
 #else
@@ -2245,7 +2245,7 @@ substNameWithKind :: Name -> Kind -> Type -> Type
 substNameWithKind n k = substKind (M.singleton n k)
 
 substNamesWithKindStar :: [Name] -> Type -> Type
-substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns
+substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns
 
 -------------------------------------------------------------------------------
 -- Error messages
@@ -2394,13 +2394,12 @@ data StarKindStatus = NotKindStar
 
 -- | Does a Type have kind * or k (for some kind variable k)?
 canRealizeKindStar :: Type -> StarKindStatus
-canRealizeKindStar t
-  | hasKindStar t = KindStar
-  | otherwise = case t of
+canRealizeKindStar t = case t of
+    _ | hasKindStar t -> KindStar
 #if MIN_VERSION_template_haskell(2,8,0)
-                     SigT _ (VarT k) -> IsKindVar k
+    SigT _ (VarT k) -> IsKindVar k
 #endif
-                     _               -> NotKindStar
+    _ -> NotKindStar
 
 -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
 -- Otherwise, returns 'Nothing'.
diff --git a/Data/Aeson/Types/ToJSON.hs b/Data/Aeson/Types/ToJSON.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
@@ -132,6 +131,8 @@ import qualified Data.ByteString.Internal as S
 import qualified Data.ByteString.Lazy.Internal as L
 #endif
 
+{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}
+
 toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
 toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)
 {-# INLINE toJSONPair #-}
@@ -2827,8 +2828,8 @@ packChunks :: L.ByteString -> S.ByteString
 packChunks lbs =
     S.unsafeCreate (fromIntegral $ L.length lbs) (copyChunks lbs)
   where
-    copyChunks !L.Empty                         !_pf = return ()
-    copyChunks !(L.Chunk (S.PS fpbuf o l) lbs') !pf  = do
+    copyChunks L.Empty                         _pf = return ()
+    copyChunks (L.Chunk (S.PS fpbuf o l) lbs') pf  = do
         withForeignPtr fpbuf $ \pbuf ->
             copyBytes pf (pbuf `plusPtr` o) l
         copyChunks lbs' (pf `plusPtr` l)
diff --git a/HLint.hs b/HLint.hs
@@ -0,0 +1,10 @@
+module HLint.HLint where
+
+import "hint" HLint.Default
+import "hint" HLint.Builtin.All
+import "hint" HLint.Dollar
+
+ignore "Avoid lambda"
+ignore "Eta reduce"
+ignore "Functor law"
+ignore "Use >=>"
diff --git a/Makefile b/Makefile
@@ -0,0 +1,2 @@
+lint:
+	hlint --cpp-include include/ --cpp-file .stack-work/dist/*/*Cabal-*/build/autogen/cabal_macros.h .
diff --git a/benchmarks/AesonCompareAutoInstances.hs b/benchmarks/AesonCompareAutoInstances.hs
@@ -43,7 +43,7 @@ d :: T
 d = Record
     { testOne = 1234.56789
     , testTwo = True
-    , testThree = Product "Hello World!" 'a' $
+    , testThree = Product "Hello World!" 'a'
                     Record
                     { testOne   = 9876.54321
                     , testTwo   = False
@@ -80,7 +80,7 @@ d' :: T'
 d' = Record'
     { testOne' = 1234.56789
     , testTwo' = True
-    , testThree' = Product' "Hello World!" 'a' $
+    , testThree' = Product' "Hello World!" 'a'
                     Record'
                     { testOne'   = 9876.54321
                     , testTwo'   = False
diff --git a/benchmarks/AesonEncode.hs b/benchmarks/AesonEncode.hs
@@ -7,7 +7,6 @@ import Prelude ()
 import Prelude.Compat
 
 import Control.DeepSeq
-import Control.Exception
 import Control.Monad
 import Data.Aeson
 import Data.Attoparsec.ByteString (IResult(..), parseWith)
@@ -25,7 +24,7 @@ main = do
         (c:a) -> (c,a)
         [] -> error "Unexpected empty list"
   let count = read cnt :: Int
-  forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
+  forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
     putStrLn $ arg ++ ":"
     let refill = B.hGet h 16384
     result0 <- parseWith refill json =<< refill
@@ -35,7 +34,7 @@ main = do
     start <- getCurrentTime
     let loop !n r
             | n >= count = return ()
-            | otherwise = {-# SCC "loop" #-} do
+            | otherwise = {-# SCC "loop" #-}
           rnf (encode r) `seq` loop (n+1) r
     loop 0 r0
     delta <- flip diffUTCTime start `fmap` getCurrentTime
diff --git a/benchmarks/AesonMap.hs b/benchmarks/AesonMap.hs
@@ -97,16 +97,16 @@ value1000 = value 1000
 value10000 = value 10000
 
 encodedValue10 :: LBS.ByteString
-encodedValue10 = B.encode $ value10
+encodedValue10 = B.encode value10
 
 encodedValue100 :: LBS.ByteString
-encodedValue100 = B.encode $ value100
+encodedValue100 = B.encode value100
 
 encodedValue1000 :: LBS.ByteString
-encodedValue1000 = B.encode $ value1000
+encodedValue1000 = B.encode value1000
 
 encodedValue10000 :: LBS.ByteString
-encodedValue10000 = B.encode $ value10000
+encodedValue10000 = B.encode value10000
 
 -------------------------------------------------------------------------------
 -- Helpers
diff --git a/benchmarks/AesonParse.hs b/benchmarks/AesonParse.hs
@@ -8,7 +8,6 @@ import Prelude ()
 import Prelude.Compat
 
 import "aeson-benchmarks" Data.Aeson
-import Control.Exception
 import Control.Monad
 import Data.Attoparsec.ByteString (IResult(..), parseWith)
 import Data.Time.Clock
@@ -21,7 +20,7 @@ main = do
   (bs:cnt:args) <- getArgs
   let count = read cnt :: Int
       blkSize = read bs
-  forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
+  forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
     putStrLn $ arg ++ ":"
     start <- getCurrentTime
     let loop !good !bad
diff --git a/benchmarks/AesonTuples.hs b/benchmarks/AesonTuples.hs
@@ -1,5 +1,3 @@
-module Main where
-
 module Main (main) where
 
 import Prelude ()
diff --git a/benchmarks/Compare/JsonBench.hs b/benchmarks/Compare/JsonBench.hs
@@ -3,7 +3,6 @@
 -- https://github.com/chadaustin/buffer-builder/blob/master/test.json
 
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -65,10 +64,10 @@ instance NFData Gender where rnf !_ = ()
 instance NFData Fruit where rnf !_ = ()
 
 instance NFData Friend where
-    rnf Friend {..} = (rnf fId) `seq` (rnf fName) `seq` ()
+    rnf Friend {..} = rnf fId `seq` rnf fName `seq` ()
 
 instance NFData User where
-    rnf User {..} = (rnf uId) `seq` (rnf uIndex) `seq` (rnf uGuid) `seq` (rnf uIsActive) `seq` (rnf uBalance) `seq` (rnf uPicture) `seq` (rnf uAge) `seq` (rnf uEyeColor) `seq` (rnf uName) `seq` (rnf uGender) `seq` (rnf uCompany) `seq` (rnf uEmail) `seq` (rnf uPhone) `seq` (rnf uAddress) `seq` (rnf uAbout) `seq` (rnf uRegistered) `seq` (rnf uLatitude) `seq` (rnf uLongitude) `seq` (rnf uTags) `seq` (rnf uFriends) `seq` (rnf uGreeting) `seq` (rnf uFavouriteFruit) `seq` ()
+    rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit `seq` ()
 
 eyeColorTable :: [(Text, EyeColor)]
 eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
diff --git a/benchmarks/CompareWithJSON.hs b/benchmarks/CompareWithJSON.hs
@@ -9,6 +9,7 @@ import Blaze.ByteString.Builder (toLazyByteString)
 import Blaze.ByteString.Builder.Char.Utf8 (fromString)
 import Control.DeepSeq (NFData(rnf))
 import Criterion.Main
+import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Text as A
 import qualified Data.ByteString.Lazy as BL
@@ -35,14 +36,10 @@ decodeJ s =
     J.Error _ -> error "fail to parse via JSON"
 
 decodeA :: BL.ByteString -> A.Value
-decodeA s = case A.decode s of
-              Just v -> v
-              Nothing -> error "fail to parse via Aeson"
+decodeA s = fromMaybe (error "fail to parse via Aeson") $ A.decode s
 
 decodeA' :: BL.ByteString -> A.Value
-decodeA' s = case A.decode' s of
-               Just v -> v
-               Nothing -> error "fail to parse via Aeson"
+decodeA' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s
 
 encodeJ :: J.JSValue -> BL.ByteString
 encodeJ = toLazyByteString . fromString . J.encode
diff --git a/benchmarks/Dates.hs b/benchmarks/Dates.hs
@@ -22,22 +22,22 @@ main = do
   defaultMain [
       bgroup "decode" [
         bgroup "UTCTime" [
-          env file1 $ \ ~bs -> bench "whole" $ nf utcTime bs
-        , env file2 $ \ ~bs -> bench "fractional" $ nf utcTime bs
+          env file1 $ \bs -> bench "whole" $ nf utcTime bs
+        , env file2 $ \bs -> bench "fractional" $ nf utcTime bs
         ]
       , bgroup "ZonedTime" [
-          env file1 $ \ ~bs -> bench "whole" $ nf zTime bs
-        , env file2 $ \ ~bs -> bench "fractional" $ nf zTime bs
+          env file1 $ \bs -> bench "whole" $ nf zTime bs
+        , env file2 $ \bs -> bench "fractional" $ nf zTime bs
         ]
       ]
     , bgroup "encode" [
         bgroup "UTCTime" [
-          env (utcTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts
-        , env (utcTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts
+          env (utcTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
+        , env (utcTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
         ]
       , bgroup "ZonedTime" [
-          env (zTime <$> file1) $ \ ~ts -> bench "whole" $ nf encode ts
-        , env (zTime <$> file2) $ \ ~ts -> bench "fractional" $ nf encode ts
+          env (zTime <$> file1) $ \ts -> bench "whole" $ nf encode ts
+        , env (zTime <$> file2) $ \ts -> bench "fractional" $ nf encode ts
         ]
       ]
     ]
diff --git a/benchmarks/ReadFile.hs b/benchmarks/ReadFile.hs
@@ -20,7 +20,7 @@ import qualified Data.ByteString as B
 main = do
   (cnt:args) <- getArgs
   let count = read cnt :: Int
-  forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
+  forM_ args $ \arg -> withFile arg ReadMode $ \h -> do
     putStrLn $ arg ++ ":"
     start <- getCurrentTime
     let loop !n
diff --git a/benchmarks/Typed/Common.hs b/benchmarks/Typed/Common.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE CPP #-}
+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
 {-# LANGUAGE PackageImports #-}
+#endif
 
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 
diff --git a/examples/Twitter.hs b/examples/Twitter.hs
@@ -29,6 +29,9 @@ import Data.Text (Text)
 import GHC.Generics (Generic)
 import Prelude hiding (id)
 
+{-# ANN module "Hlint: ignore Use camelCase" #-}
+{-# ANN module "Hlint: ignore Use newtype instead of data" #-}
+
 data Metadata = Metadata {
     result_type :: Text
   } deriving (Eq, Show, Typeable, Data, Generic)
diff --git a/examples/Twitter/Generic.hs b/examples/Twitter/Generic.hs
@@ -1,6 +1,5 @@
 -- Use GHC generics to automatically generate good instances.
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Twitter.Generic
diff --git a/examples/Twitter/Manual.hs b/examples/Twitter/Manual.hs
@@ -1,11 +1,14 @@
 -- Manually write instances.
 
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
+{-# LANGUAGE PackageImports #-}
+#endif
+
 module Twitter.Manual
     (
       Metadata(..)
diff --git a/pure/Data/Aeson/Parser/UnescapePure.hs b/pure/Data/Aeson/Parser/UnescapePure.hs
@@ -52,23 +52,23 @@ setByte1 point word = point .|. fromIntegral (word .&. 0x3f)
 {-# INLINE setByte1 #-}
 
 setByte2 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
-setByte2 point word = point .|. ((fromIntegral $ word .&. 0x3f) `shiftL` 6)
+setByte2 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 6)
 {-# INLINE setByte2 #-}
 
 setByte2Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
-setByte2Top point word = point .|. ((fromIntegral $ word .&. 0x1f) `shiftL` 6)
+setByte2Top point word = point .|. (fromIntegral (word .&. 0x1f) `shiftL` 6)
 {-# INLINE setByte2Top #-}
 
 setByte3 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
-setByte3 point word = point .|. ((fromIntegral $ word .&. 0x3f) `shiftL` 12)
+setByte3 point word = point .|. (fromIntegral (word .&. 0x3f) `shiftL` 12)
 {-# INLINE setByte3 #-}
 
 setByte3Top :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
-setByte3Top point word = point .|. ((fromIntegral $ word .&. 0xf) `shiftL` 12)
+setByte3Top point word = point .|. (fromIntegral (word .&. 0xf) `shiftL` 12)
 {-# INLINE setByte3Top #-}
 
 setByte4 :: (Num a, Bits b, Bits a, Integral b) => a -> b -> a
-setByte4 point word = point .|. ((fromIntegral $ word .&. 0x7) `shiftL` 18)
+setByte4 point word = point .|. (fromIntegral (word .&. 0x7) `shiftL` 18)
 {-# INLINE setByte4 #-}
 
 decode :: Utf -> Word32 -> Word8 -> (Utf, Word32)
@@ -207,12 +207,12 @@ unescapeText' bs = runText $ \done -> do
         let u = w' .|. w in
 
         -- Get next state based on surrogates.
-        let st =
-              if u >= 0xd800 && u <= 0xdbff then -- High surrogate.
+        let st
+              | u >= 0xd800 && u <= 0xdbff = -- High surrogate.
                 StateS0
-              else if u >= 0xdc00 && u <= 0xdfff then -- Low surrogate.
+              | u >= 0xdc00 && u <= 0xdfff = -- Low surrogate.
                 throwDecodeError
-              else
+              | otherwise =
                 StateNone
         in
         writeAndReturn dest pos u st
diff --git a/tests/Instances.hs b/tests/Instances.hs
diff --git a/tests/Properties.hs b/tests/Properties.hs
diff --git a/tests/SerializationFormatSpec.hs b/tests/SerializationFormatSpec.hs
diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs
diff --git a/travis/script.sh b/travis/script.sh

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+lint:`
	`2`	`+ hlint --cpp-include include/ --cpp-file .stack-work/dist//Cabal-*/build/autogen/cabal_macros.h .`