Merge pull request #896 from phadej/hlint

Update hlint.yaml and fix some hints in servant and servant-server

Author: phadej

HLint.hs

@@ -0,0 +1,65 @@
+# 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: Redundant do}
+- ignore: {name: Parse error}
+- ignore: {name: Use fmap}
+- ignore: {name: Use list comprehension}
+- ignore: {name: Use lambda-case}
+- ignore: {name: Eta reduce}
+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
+
+
+# Define some custom infix operators
+# - fixity: infixr 3 ~^#^~
+
+
+# To generate a suitable file for HLint do:
+# $ hlint --default > .hlint.yaml

hlint.yaml

@@ -1,7 +1,6 @@
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE TypeFamilies      #-}
 

servant-server/src/Servant/Server.hs

@@ -326,7 +326,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \
                       write . BB.lazyByteString $ header framingproxy ctypeproxy
                       case boundary framingproxy ctypeproxy of
                            BoundaryStrategyBracket f ->
-                                    let go x = let bs = mimeRender ctypeproxy $ x
+                                    let go x = let bs = mimeRender ctypeproxy x
                                                    (before, after) = f bs
                                                in write (   BB.lazyByteString before
                                                          <> BB.lazyByteString bs

servant-server/src/Servant/Server/Internal.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}

servant-server/src/Servant/Server/Internal/Handler.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Servant.Server.Internal.Router where
 

servant-server/src/Servant/Server/Internal/Router.hs

@@ -3,12 +3,8 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
@@ -82,7 +78,7 @@ instance MonadBaseControl b m => MonadBaseControl b (RouteResultT m) where
 
 instance MonadTransControl RouteResultT where
     type StT RouteResultT a = RouteResult a
-    liftWith f = RouteResultT $ liftM return $ f $ runRouteResultT
+    liftWith f = RouteResultT $ liftM return $ f runRouteResultT
     restoreT = RouteResultT
 
 instance MonadThrow m => MonadThrow (RouteResultT m) where
@@ -367,7 +363,7 @@ runAction :: Delayed env (Handler a)
           -> (RouteResult Response -> IO r)
           -> (a -> RouteResult Response)
           -> IO r
-runAction action env req respond k = runResourceT $ do
+runAction action env req respond k = runResourceT $
     runDelayed action env req >>= go >>= liftIO . respond
   where
     go (Fail e)      = return $ Fail e

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

@@ -282,7 +282,7 @@ instance OVERLAPPABLE_
          , AllMimeRender (ctyp' ': ctyps) a
          ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
     allMimeRender _ a =
-        (map (, bs) $ NE.toList $ contentTypes pctyp)
+        map (, bs) (NE.toList $ contentTypes pctyp)
         ++ allMimeRender pctyps a
       where
         bs     = mimeRender pctyp a
@@ -317,10 +317,10 @@ instance ( MimeUnrender ctyp a
          , AllMimeUnrender ctyps a
          ) => AllMimeUnrender (ctyp ': ctyps) a where
     allMimeUnrender _ =
-        (map mk $ NE.toList $ contentTypes pctyp)
+        map mk (NE.toList $ contentTypes pctyp)
         ++ allMimeUnrender pctyps
       where
-        mk ct   = (ct, \bs -> mimeUnrenderWithType pctyp ct bs)
+        mk ct   = (ct, mimeUnrenderWithType pctyp ct)
         pctyp  = Proxy :: Proxy ctyp
         pctyps = Proxy :: Proxy ctyps
 

servant/src/Servant/API/ContentTypes.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFunctor      #-}
 {-# LANGUAGE PolyKinds          #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Header (

servant/src/Servant/API/Header.hs

@@ -67,7 +67,7 @@ data HList a where
 
 type family HeaderValMap (f :: * -> *) (xs :: [*]) where
     HeaderValMap f '[]                = '[]
-    HeaderValMap f (Header h x ': xs) = Header h (f x) ': (HeaderValMap f xs)
+    HeaderValMap f (Header h x ': xs) = Header h (f x) ': HeaderValMap f xs
 
 
 class BuildHeadersTo hs where
@@ -80,7 +80,7 @@ instance OVERLAPPING_ BuildHeadersTo '[] where
     buildHeadersTo _ = HNil
 
 instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
-         => BuildHeadersTo ((Header h v) ': xs) where
+         => BuildHeadersTo (Header h v ': xs) where
     buildHeadersTo headers =
       let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
           matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers