From dadfe965b91c550e599933b2f430aa06a582e0f7 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Tue, 30 Oct 2018 12:46:57 -0500 Subject: [PATCH] Do hlint 2.1 hints --- src/PostgREST/ApiRequest.hs | 9 ++++----- src/PostgREST/App.hs | 8 ++++---- src/PostgREST/Auth.hs | 4 ++-- src/PostgREST/DbRequestBuilder.hs | 4 ++-- src/PostgREST/DbStructure.hs | 2 +- src/PostgREST/Middleware.hs | 2 +- src/PostgREST/OpenAPI.hs | 2 +- src/PostgREST/Parsers.hs | 18 ++++++++++-------- src/PostgREST/QueryBuilder.hs | 6 +++--- src/PostgREST/RangeQuery.hs | 7 +++---- test/Feature/AsymmetricJwtSpec.hs | 2 +- test/Feature/BinaryJwtSecretSpec.hs | 2 +- test/Feature/ConcurrentSpec.hs | 2 +- test/Feature/CorsSpec.hs | 2 +- test/Feature/NoJwtSpec.hs | 2 +- test/Feature/PgVersion95Spec.hs | 2 +- test/Feature/PgVersion96Spec.hs | 2 +- test/Feature/ProxySpec.hs | 4 ++-- test/Feature/QueryLimitedSpec.hs | 2 +- test/Feature/QuerySpec.hs | 2 +- test/Feature/RpcSpec.hs | 4 ++-- test/Feature/StructureSpec.hs | 2 +- test/SpecHelper.hs | 9 ++++----- 23 files changed, 49 insertions(+), 50 deletions(-) diff --git a/src/PostgREST/ApiRequest.hs b/src/PostgREST/ApiRequest.hs index abd1a25e2..ded9e6b65 100644 --- a/src/PostgREST/ApiRequest.hs +++ b/src/PostgREST/ApiRequest.hs @@ -110,8 +110,7 @@ userApiRequest schema req reqBody iAction = action , iTarget = target , iRange = ranges - , iAccepts = fromMaybe [CTAny] $ - map decodeContentType . parseHttpAccept <$> lookupHeader "accept" + , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept" , iPayload = relevantPayload , iPreferRepresentation = representation , iPreferSingleObjectParameter = singleObject @@ -130,7 +129,7 @@ userApiRequest schema req reqBody $ rawQueryString req , iJWT = tokenStr , iHeaders = [ (toS $ CI.foldedCase k, toS v) | (k,v) <- hdrs, k /= hAuthorization, k /= hCookie] - , iCookies = fromMaybe [] $ parseCookiesText <$> lookupHeader "Cookie" + , iCookies = maybe [] parseCookiesText $ lookupHeader "Cookie" } where -- rpcQParams = Rpc query params e.g. /rpc/name?param1=val1, similar to filter but with no operator(eq, lt..) @@ -143,7 +142,7 @@ userApiRequest schema req reqBody ((<> ".") <$> "not":M.keys operators) ++ ((<> "(") <$> M.keys ftsOperators) isEmbedPath = T.isInfixOf "." - isTargetingProc = fromMaybe False $ (== "rpc") <$> listToMaybe path + isTargetingProc = (== Just "rpc") $ listToMaybe path payload = case (decodeContentType . fromMaybe "application/json" $ lookupHeader "content-type", action) of (_, ActionInvoke{isReadOnly=True}) -> @@ -215,7 +214,7 @@ userApiRequest schema req reqBody limitParams :: M.HashMap ByteString NonnegRange limitParams = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k] offsetParams :: M.HashMap ByteString NonnegRange - offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k] + offsetParams = M.fromList [(toS (replaceLast "limit" k), maybe allRange rangeGeq (readMaybe =<< (toS <$> v))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k] urlRange = M.unionWith f limitParams offsetParams where diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index ff12b6ddf..477a4a449 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -109,7 +109,7 @@ transactionMode proc action = ActionInfo -> HT.Read ActionInspect -> HT.Read ActionInvoke{isReadOnly=False} -> - let v = fromMaybe Volatile $ pdVolatility <$> proc in + let v = maybe Volatile pdVolatility proc in if v == Stable || v == Immutable then HT.Read else HT.Write @@ -286,7 +286,7 @@ app dbStructure proc conf apiRequest = PJObject -> True PJArray _ -> False singular = contentType == CTSingularJSON - specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ fromMaybe [] (pdArgs <$> proc) + specifiedPgArgs = filter ((`S.member` pjKeys) . pgaName) $ maybe [] pdArgs proc row <- H.statement (toS pjRaw) $ callProc qi specifiedPgArgs returnsScalar q cq shouldCount singular (iPreferSingleObjectParameter apiRequest) @@ -397,8 +397,8 @@ contentRangeH lower upper total = rangeString | totalNotZero && fromInRange = show lower <> "-" <> show upper | otherwise = "*" - totalString = fromMaybe "*" (show <$> total) - totalNotZero = fromMaybe True ((/=) 0 <$> total) + totalString = maybe "*" show total + totalNotZero = maybe True (0 /=) total fromInRange = lower <= upper extractQueryResult :: Maybe ResultsWithCount -> ResultsWithCount diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 43f249435..2e359a94c 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -95,7 +95,7 @@ parseJWK str = hs256jwk :: ByteString -> JWK hs256jwk key = fromKeyMaterial km - & jwkUse .~ Just Sig - & jwkAlg .~ (Just $ JWSAlg HS256) + & jwkUse ?~ Sig + & jwkAlg ?~ JWSAlg HS256 where km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key)) diff --git a/src/PostgREST/DbRequestBuilder.hs b/src/PostgREST/DbRequestBuilder.hs index b48c23fcf..f87c0685a 100644 --- a/src/PostgREST/DbRequestBuilder.hs +++ b/src/PostgREST/DbRequestBuilder.hs @@ -36,7 +36,7 @@ import PostgREST.Parsers import PostgREST.RangeQuery (NonnegRange, restrictRange, allRange) import PostgREST.Types -import Protolude hiding (from, dropWhile, drop) +import Protolude hiding (from) import Text.Regex.TDFA ((=~)) import Unsafe (unsafeHead) @@ -229,7 +229,7 @@ getJoinConditions (Relation Table{tableSchema=tSchema, tableName=tN} cols Table{ if | typ == Child || typ == Parent -> zipWith (toJoinCondition tN ftN) cols fCols | typ == Many -> - let ltN = fromMaybe "" (tableName <$> lt) in + let ltN = maybe "" tableName lt in zipWith (toJoinCondition tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toJoinCondition ftN ltN) fCols (fromMaybe [] lc2) | typ == Root -> witness where diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index 7382e8daa..a4af0c7da 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -538,7 +538,7 @@ columnFromRow tabs (s, t, n, desc, pos, nul, typ, u, l, p, d, e) = buildColumn < buildColumn tbl = Column tbl n desc pos nul typ u l p d (parseEnum e) Nothing table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs parseEnum :: Maybe Text -> [Text] - parseEnum str = fromMaybe [] $ split (==',') <$> str + parseEnum = maybe [] (split (==',')) allChildRelations :: [Table] -> [Column] -> H.Statement () [Relation] allChildRelations tabs cols = diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index f908c3b21..3aedd3fad 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -21,7 +21,7 @@ import PostgREST.Config (AppConfig (..), corsPolicy) import PostgREST.Error (simpleError) import PostgREST.QueryBuilder (pgFmtLit, unquoted, pgFmtSetLocal) -import Protolude hiding (concat, null) +import Protolude runWithClaims :: AppConfig -> JWTAttempt -> (ApiRequest -> H.Transaction Response) -> diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index 20ffda41d..e64e59807 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -60,7 +60,7 @@ makeProperty pks c = (colName c, Inline s) ] d = if length n > 1 then - Just $ append (fromMaybe "" ((`append` "\n\n") <$> colDescription c)) (intercalate "\n" n) + Just $ append (maybe "" (`append` "\n\n") $ colDescription c) (intercalate "\n" n) else colDescription c s = diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index 7e682f1ea..97a12b2e4 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -3,6 +3,7 @@ module PostgREST.Parsers where import Protolude hiding (try, intercalate, replace, option) import Control.Monad ((>>)) import Data.Foldable (foldl1) +import Data.Functor (($>)) import qualified Data.HashMap.Strict as M import Data.Text (intercalate, replace, strip) import Data.List (init, last) @@ -68,17 +69,18 @@ pFieldForest = pFieldTree `sepBy1` lexeme (char ',') Node <$> pFieldSelect <*> pure [] pStar :: Parser Text -pStar = toS <$> (string "*" *> pure ("*"::ByteString)) +pStar = toS <$> (string "*" $> ("*"::ByteString)) pFieldName :: Parser Text -pFieldName = do - matches <- (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) "field name (* or [a..z0..9_])" - return $ intercalate "-" $ map toS matches +pFieldName = + intercalate "-" . map toS <$> + (many1 (letter <|> digit <|> oneOf "_") `sepBy1` dash) + "field name (* or [a..z0..9_])" where isDash :: GenParser Char st () isDash = try ( char '-' >> notFollowedBy (char '>') ) dash :: Parser Char - dash = isDash *> pure '-' + dash = isDash $> '-' pJsonPath :: Parser JsonPath pJsonPath = many pJsonOperation @@ -184,12 +186,12 @@ pLogicTree = Stmnt <$> try pLogicFilter pLogicFilter :: Parser Filter pLogicFilter = Filter <$> pField <* pDelimiter <*> pOpExpr pLogicSingleVal pNot :: Parser Bool - pNot = try (string "not" *> pDelimiter *> pure True) + pNot = try (string "not" *> pDelimiter $> True) <|> pure False "negation operator (not)" pLogicOp :: Parser LogicOperator - pLogicOp = try (string "and" *> pure And) - <|> string "or" *> pure Or + pLogicOp = try (string "and" $> And) + <|> string "or" $> Or "logic operator (and, or)" pLogicSingleVal :: Parser SingleVal diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index c959264ee..72e78f32b 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -47,7 +47,7 @@ import Data.Scientific ( FPFormat (..) , formatScientific , isInteger ) -import Protolude hiding (from, intercalate, ord, cast, replace) +import Protolude hiding ( intercalate, cast, replace) import PostgREST.ApiRequest (PreferRepresentation (..)) {-| The generic query result format used by API responses. The location header @@ -229,7 +229,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls logicForest ("LIMIT " <> maybe "ALL" show (rangeLimit range) <> " OFFSET " <> show (rangeOffset range)) `emptyOnFalse` (isParent || range == allRange) ] where - mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation) + mainTbl = maybe nodeName (tableName . relTable) maybeRelation isSelfJoin = maybe False (\r -> relType r /= Root && relTable r == relFTable r) maybeRelation (qi, tables, joinConds) = let depthAlias name dpth = if dpth /= 0 then name <> "_" <> show dpth else name in -- Root node doesn't get aliased @@ -413,7 +413,7 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper In vals -> pgFmtField table fld <> " " <> let emptyValForIn = "= any('{}') " in -- Workaround because for postgresql "col IN ()" is invalid syntax, we instead do "col = any('{}')" - case ((&&) (length vals == 1) . T.null) <$> headMay vals of + case (&&) (length vals == 1) . T.null <$> headMay vals of Just False -> sqlOperator "in" <> "(" <> intercalate ", " (map unknownLiteral vals) <> ") " Just True -> emptyValForIn Nothing -> emptyValForIn diff --git a/src/PostgREST/RangeQuery.hs b/src/PostgREST/RangeQuery.hs index ef85e8da1..cd7ffc69b 100644 --- a/src/PostgREST/RangeQuery.hs +++ b/src/PostgREST/RangeQuery.hs @@ -32,14 +32,13 @@ rangeParse range = do case listToMaybe (range =~ rangeRegex :: [[BS.ByteString]]) of Just parsedRange -> let [_, mLower, mUpper] = readMaybe . toS <$> parsedRange - lower = fromMaybe emptyRange (rangeGeq <$> mLower) - upper = fromMaybe allRange (rangeLeq <$> mUpper) in + lower = maybe emptyRange rangeGeq mLower + upper = maybe allRange rangeLeq mUpper in rangeIntersection lower upper Nothing -> allRange rangeRequested :: RequestHeaders -> NonnegRange -rangeRequested headers = fromMaybe allRange $ - rangeParse <$> lookup hRange headers +rangeRequested headers = maybe allRange rangeParse $ lookup hRange headers restrictRange :: Maybe Integer -> NonnegRange -> NonnegRange restrictRange Nothing r = r diff --git a/test/Feature/AsymmetricJwtSpec.hs b/test/Feature/AsymmetricJwtSpec.hs index e7952fdda..95c5a3f04 100644 --- a/test/Feature/AsymmetricJwtSpec.hs +++ b/test/Feature/AsymmetricJwtSpec.hs @@ -8,7 +8,7 @@ import Network.HTTP.Types import SpecHelper import Network.Wai (Application) -import Protolude hiding (get) +import Protolude -- }}} spec :: SpecWith Application diff --git a/test/Feature/BinaryJwtSecretSpec.hs b/test/Feature/BinaryJwtSecretSpec.hs index 08230b4ca..f42196144 100644 --- a/test/Feature/BinaryJwtSecretSpec.hs +++ b/test/Feature/BinaryJwtSecretSpec.hs @@ -8,7 +8,7 @@ import Network.HTTP.Types import SpecHelper import Network.Wai (Application) -import Protolude hiding (get) +import Protolude -- }}} spec :: SpecWith Application diff --git a/test/Feature/ConcurrentSpec.hs b/test/Feature/ConcurrentSpec.hs index eacdb20f0..d7d412188 100644 --- a/test/Feature/ConcurrentSpec.hs +++ b/test/Feature/ConcurrentSpec.hs @@ -8,7 +8,7 @@ import Control.Monad.Base import Control.Monad.Trans.Control import Control.Concurrent.Async (mapConcurrently) -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai.Internal import Test.Hspec.Wai import Test.Hspec.Wai.JSON diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index f8e3cd243..142488f58 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -11,7 +11,7 @@ import SpecHelper import Network.HTTP.Types import Network.Wai (Application) -import Protolude hiding (get) +import Protolude -- }}} spec :: SpecWith Application diff --git a/test/Feature/NoJwtSpec.hs b/test/Feature/NoJwtSpec.hs index af7a1ad7a..471fdf600 100644 --- a/test/Feature/NoJwtSpec.hs +++ b/test/Feature/NoJwtSpec.hs @@ -8,7 +8,7 @@ import Network.HTTP.Types import SpecHelper import Network.Wai (Application) -import Protolude hiding (get) +import Protolude -- }}} spec :: SpecWith Application diff --git a/test/Feature/PgVersion95Spec.hs b/test/Feature/PgVersion95Spec.hs index 62c06ca8a..b36abbde6 100644 --- a/test/Feature/PgVersion95Spec.hs +++ b/test/Feature/PgVersion95Spec.hs @@ -1,6 +1,6 @@ module Feature.PgVersion95Spec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON diff --git a/test/Feature/PgVersion96Spec.hs b/test/Feature/PgVersion96Spec.hs index 233239ea1..ecc0e8600 100644 --- a/test/Feature/PgVersion96Spec.hs +++ b/test/Feature/PgVersion96Spec.hs @@ -1,6 +1,6 @@ module Feature.PgVersion96Spec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON diff --git a/test/Feature/ProxySpec.hs b/test/Feature/ProxySpec.hs index d9b44d9d9..2c806c3f1 100644 --- a/test/Feature/ProxySpec.hs +++ b/test/Feature/ProxySpec.hs @@ -1,12 +1,12 @@ module Feature.ProxySpec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import SpecHelper import Network.Wai (Application) -import Protolude hiding (get) +import Protolude spec :: SpecWith Application spec = diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs index a3bacae76..39200c679 100644 --- a/test/Feature/QueryLimitedSpec.hs +++ b/test/Feature/QueryLimitedSpec.hs @@ -1,6 +1,6 @@ module Feature.QueryLimitedSpec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index ed50b200b..6160e409e 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -1,6 +1,6 @@ module Feature.QuerySpec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs index d281cea58..977b7c881 100644 --- a/test/Feature/RpcSpec.hs +++ b/test/Feature/RpcSpec.hs @@ -1,6 +1,6 @@ module Feature.RpcSpec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Network.HTTP.Types @@ -372,7 +372,7 @@ spec = [json|[{"text_search_vector":"'amus':5 'fair':7 'impossibl':9 'peu':4"},{"text_search_vector":"'art':4 'spass':5 'unmog':7"}]|] { matchHeaders = [matchContentTypeJson] } - it "should work with an argument of custom type in public schema" $ do + it "should work with an argument of custom type in public schema" $ get "/rpc/test_arg?my_arg=something" `shouldRespondWith` [json|"foobar"|] { matchHeaders = [matchContentTypeJson] } diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 0427b0f5a..e15017798 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -1,6 +1,6 @@ module Feature.StructureSpec where -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Network.HTTP.Types diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index f158bd6de..0e5867ca9 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -19,7 +19,7 @@ import Text.Heredoc import PostgREST.Config (AppConfig(..)) import PostgREST.Types (JSPathExp(..)) -import Test.Hspec hiding (pendingWith) +import Test.Hspec import Test.Hspec.Wai import Network.HTTP.Types @@ -61,9 +61,8 @@ validateOpenApiResponse headers = do D4.fetchFilesystemAndValidate schemaContext ((fromJust . decode) respBody) `shouldReturn` Right () getEnvVarWithDefault :: Text -> Text -> IO Text -getEnvVarWithDefault var def = do - varValue <- getEnv (toS var) `E.catchIOError` const (return $ toS def) - return $ toS varValue +getEnvVarWithDefault var def = toS <$> + getEnv (toS var) `E.catchIOError` const (return $ toS def) _baseCfg :: AppConfig _baseCfg = -- Connection Settings @@ -166,5 +165,5 @@ isErrorFormat s = S.null (S.difference keys validKeys) where obj = decode s :: Maybe (M.Map Text Value) - keys = fromMaybe S.empty (M.keysSet <$> obj) + keys = maybe S.empty M.keysSet obj validKeys = S.fromList ["message", "details", "hint", "code"]