Update hlint.yaml and fix some hints in servant and servant-server
This commit is contained in:
parent
030cbbc363
commit
22ec980f6e
12 changed files with 74 additions and 24 deletions
6
HLint.hs
6
HLint.hs
|
@ -1,6 +0,0 @@
|
||||||
import "hint" HLint.Default
|
|
||||||
|
|
||||||
ignore "Redundant do"
|
|
||||||
ignore "Parse error"
|
|
||||||
ignore "Use list comprehension"
|
|
||||||
ignore "Use liftM"
|
|
65
hlint.yaml
Normal file
65
hlint.yaml
Normal file
|
@ -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
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE ConstraintKinds #-}
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
|
|
|
@ -326,7 +326,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \
|
||||||
write . BB.lazyByteString $ header framingproxy ctypeproxy
|
write . BB.lazyByteString $ header framingproxy ctypeproxy
|
||||||
case boundary framingproxy ctypeproxy of
|
case boundary framingproxy ctypeproxy of
|
||||||
BoundaryStrategyBracket f ->
|
BoundaryStrategyBracket f ->
|
||||||
let go x = let bs = mimeRender ctypeproxy $ x
|
let go x = let bs = mimeRender ctypeproxy x
|
||||||
(before, after) = f bs
|
(before, after) = f bs
|
||||||
in write ( BB.lazyByteString before
|
in write ( BB.lazyByteString before
|
||||||
<> BB.lazyByteString bs
|
<> BB.lazyByteString bs
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Servant.Server.Internal.Router where
|
module Servant.Server.Internal.Router where
|
||||||
|
|
||||||
|
|
|
@ -3,12 +3,8 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
@ -82,7 +78,7 @@ instance MonadBaseControl b m => MonadBaseControl b (RouteResultT m) where
|
||||||
|
|
||||||
instance MonadTransControl RouteResultT where
|
instance MonadTransControl RouteResultT where
|
||||||
type StT RouteResultT a = RouteResult a
|
type StT RouteResultT a = RouteResult a
|
||||||
liftWith f = RouteResultT $ liftM return $ f $ runRouteResultT
|
liftWith f = RouteResultT $ liftM return $ f runRouteResultT
|
||||||
restoreT = RouteResultT
|
restoreT = RouteResultT
|
||||||
|
|
||||||
instance MonadThrow m => MonadThrow (RouteResultT m) where
|
instance MonadThrow m => MonadThrow (RouteResultT m) where
|
||||||
|
@ -367,7 +363,7 @@ runAction :: Delayed env (Handler a)
|
||||||
-> (RouteResult Response -> IO r)
|
-> (RouteResult Response -> IO r)
|
||||||
-> (a -> RouteResult Response)
|
-> (a -> RouteResult Response)
|
||||||
-> IO r
|
-> IO r
|
||||||
runAction action env req respond k = runResourceT $ do
|
runAction action env req respond k = runResourceT $
|
||||||
runDelayed action env req >>= go >>= liftIO . respond
|
runDelayed action env req >>= go >>= liftIO . respond
|
||||||
where
|
where
|
||||||
go (Fail e) = return $ Fail e
|
go (Fail e) = return $ Fail e
|
||||||
|
|
|
@ -282,7 +282,7 @@ instance OVERLAPPABLE_
|
||||||
, AllMimeRender (ctyp' ': ctyps) a
|
, AllMimeRender (ctyp' ': ctyps) a
|
||||||
) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
|
) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
|
||||||
allMimeRender _ a =
|
allMimeRender _ a =
|
||||||
(map (, bs) $ NE.toList $ contentTypes pctyp)
|
map (, bs) (NE.toList $ contentTypes pctyp)
|
||||||
++ allMimeRender pctyps a
|
++ allMimeRender pctyps a
|
||||||
where
|
where
|
||||||
bs = mimeRender pctyp a
|
bs = mimeRender pctyp a
|
||||||
|
@ -317,10 +317,10 @@ instance ( MimeUnrender ctyp a
|
||||||
, AllMimeUnrender ctyps a
|
, AllMimeUnrender ctyps a
|
||||||
) => AllMimeUnrender (ctyp ': ctyps) a where
|
) => AllMimeUnrender (ctyp ': ctyps) a where
|
||||||
allMimeUnrender _ =
|
allMimeUnrender _ =
|
||||||
(map mk $ NE.toList $ contentTypes pctyp)
|
map mk (NE.toList $ contentTypes pctyp)
|
||||||
++ allMimeUnrender pctyps
|
++ allMimeUnrender pctyps
|
||||||
where
|
where
|
||||||
mk ct = (ct, \bs -> mimeUnrenderWithType pctyp ct bs)
|
mk ct = (ct, mimeUnrenderWithType pctyp ct)
|
||||||
pctyp = Proxy :: Proxy ctyp
|
pctyp = Proxy :: Proxy ctyp
|
||||||
pctyps = Proxy :: Proxy ctyps
|
pctyps = Proxy :: Proxy ctyps
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# OPTIONS_HADDOCK not-home #-}
|
{-# OPTIONS_HADDOCK not-home #-}
|
||||||
module Servant.API.Header (
|
module Servant.API.Header (
|
||||||
|
|
|
@ -67,7 +67,7 @@ data HList a where
|
||||||
|
|
||||||
type family HeaderValMap (f :: * -> *) (xs :: [*]) where
|
type family HeaderValMap (f :: * -> *) (xs :: [*]) where
|
||||||
HeaderValMap f '[] = '[]
|
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
|
class BuildHeadersTo hs where
|
||||||
|
@ -80,7 +80,7 @@ instance OVERLAPPING_ BuildHeadersTo '[] where
|
||||||
buildHeadersTo _ = HNil
|
buildHeadersTo _ = HNil
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
|
instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
|
||||||
=> BuildHeadersTo ((Header h v) ': xs) where
|
=> BuildHeadersTo (Header h v ': xs) where
|
||||||
buildHeadersTo headers =
|
buildHeadersTo headers =
|
||||||
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
||||||
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
|
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
|
||||||
|
|
|
@ -40,7 +40,7 @@ instance ToStreamGenerator StreamGenerator a
|
||||||
where toStreamGenerator x = x
|
where toStreamGenerator x = x
|
||||||
|
|
||||||
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
|
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
|
||||||
data ResultStream a = ResultStream ((forall b. (IO (Maybe (Either String a)) -> IO b) -> IO b))
|
newtype ResultStream a = ResultStream (forall b. (IO (Maybe (Either String a)) -> IO b) -> IO b)
|
||||||
|
|
||||||
-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints.
|
-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints.
|
||||||
class BuildFromStream a b where
|
class BuildFromStream a b where
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE FunctionalDependencies #-}
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
Loading…
Reference in a new issue