Skip to content

Commit

Permalink
refactor: Remove GHC.Show instances from QualifiedIdentifier and Config
Browse files Browse the repository at this point in the history
  • Loading branch information
monacoremo committed Nov 9, 2021
1 parent 5dc37fc commit cd30135
Show file tree
Hide file tree
Showing 5 changed files with 38 additions and 34 deletions.
39 changes: 20 additions & 19 deletions src/PostgREST/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,8 +35,6 @@ import qualified Data.Configurator as C
import qualified Data.Map.Strict as M
import qualified Data.Text as T

import qualified GHC.Show (show)

import Control.Lens (preview)
import Control.Monad (fail)
import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri)
Expand All @@ -55,7 +53,8 @@ import PostgREST.Config.JSPath (JSPath, JSPathExp (..),
pRoleClaimKey)
import PostgREST.Config.Proxy (Proxy (..),
isMalformedProxyUri, toURI)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, toQi)
import PostgREST.DbStructure.Identifiers (QualifiedIdentifier, dumpQi,
toQi)
import PostgREST.Request.Types (JoinType (..))

import Protolude hiding (Proxy, toList, toS)
Expand Down Expand Up @@ -99,19 +98,21 @@ data AppConfig = AppConfig

data LogLevel = LogCrit | LogError | LogWarn | LogInfo

instance Show LogLevel where
show LogCrit = "crit"
show LogError = "error"
show LogWarn = "warn"
show LogInfo = "info"
dumpLogLevel :: LogLevel -> Text
dumpLogLevel = \case
LogCrit -> "crit"
LogError -> "error"
LogWarn -> "warn"
LogInfo -> "info"

data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
deriving Eq

instance Show OpenAPIMode where
show OAFollowPriv = "follow-privileges"
show OAIgnorePriv = "ignore-privileges"
show OADisabled = "disabled"
dumpOpenApiMode :: OpenAPIMode -> Text
dumpOpenApiMode = \case
OAFollowPriv -> "follow-privileges"
OAIgnorePriv -> "ignore-privileges"
OADisabled -> "disabled"

-- | Dump the config
toText :: AppConfig -> Text
Expand All @@ -127,21 +128,21 @@ toText conf =
,("db-max-rows", maybe "\"\"" show . configDbMaxRows)
,("db-pool", show . configDbPoolSize)
,("db-pool-timeout", show . floor . configDbPoolTimeout)
,("db-pre-request", q . maybe mempty show . configDbPreRequest)
,("db-pre-request", q . maybe mempty dumpQi . configDbPreRequest)
,("db-prepared-statements", T.toLower . show . configDbPreparedStatements)
,("db-root-spec", q . maybe mempty show . configDbRootSpec)
,("db-root-spec", q . maybe mempty dumpQi . configDbRootSpec)
,("db-schemas", q . T.intercalate "," . toList . configDbSchemas)
,("db-config", q . T.toLower . show . configDbConfig)
,("db-tx-end", q . showTxEnd)
,("db-uri", q . configDbUri)
,("db-embed-default-join", q . innerJoin . configDbEmbedDefaultJoin)
,("db-embed-default-join", q . dumpJoin . configDbEmbedDefaultJoin)
,("db-use-legacy-gucs", T.toLower . show . configDbUseLegacyGucs)
,("jwt-aud", toS . encode . maybe "" toJSON . configJwtAudience)
,("jwt-role-claim-key", q . T.intercalate mempty . fmap show . configJwtRoleClaimKey)
,("jwt-secret", q . toS . showJwtSecret)
,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64)
,("log-level", q . show . configLogLevel)
,("openapi-mode", q . show . configOpenApiMode)
,("log-level", q . dumpLogLevel . configLogLevel)
,("openapi-mode", q . dumpOpenApiMode . configOpenApiMode)
,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri)
,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes)
,("server-host", q . configServerHost)
Expand All @@ -168,8 +169,8 @@ toText conf =
secret = fromMaybe mempty $ configJwtSecret c
showSocketMode c = showOct (configServerUnixSocketMode c) mempty

innerJoin JTInner = "inner"
innerJoin JTLeft = "left"
dumpJoin JTInner = "inner"
dumpJoin JTLeft = "left"

-- This class is needed for the polymorphism of overrideFromDbOrEnvironment
-- because C.required and C.optional have different signatures
Expand Down
8 changes: 4 additions & 4 deletions src/PostgREST/DbStructure/Identifiers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,12 @@ module PostgREST.DbStructure.Identifiers
, Schema
, TableName
, FieldName
, dumpQi
, toQi
) where

import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified GHC.Show

import Protolude

Expand All @@ -26,9 +26,9 @@ data QualifiedIdentifier = QualifiedIdentifier

instance Hashable QualifiedIdentifier

instance Show QualifiedIdentifier where
show (QualifiedIdentifier s i) =
(if T.null s then mempty else toS s <> ".") <> toS i
dumpQi :: QualifiedIdentifier -> Text
dumpQi (QualifiedIdentifier s i) =
(if T.null s then mempty else s <> ".") <> i

-- TODO: Handle a case where the QI comes like this: "my.fav.schema"."my.identifier"
-- Right now it only handles the schema.identifier case
Expand Down
11 changes: 7 additions & 4 deletions src/PostgREST/Query/SqlFragment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,12 +52,15 @@ import PostgREST.DbStructure.Identifiers (FieldName,
import PostgREST.RangeQuery (NonnegRange, allRange,
rangeLimit, rangeOffset)
import PostgREST.Request.Types (Alias, Field, Filter (..),
OrderNulls(..), OrderDirection(..), LogicOperator(..),
JoinCondition (..),
JsonOperand (..),
JsonOperation (..),
JsonPath, LogicTree (..),
OpExpr (..), Operation (..),
JsonPath,
LogicOperator (..),
LogicTree (..), OpExpr (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..), SelectItem)

import Protolude hiding (cast, toS)
Expand Down Expand Up @@ -268,7 +271,7 @@ pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalate
notOp = if hasNot then "NOT" else mempty

opSql And = " AND "
opSql Or = " OR "
opSql Or = " OR "
pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt

pgFmtJsonPath :: JsonPath -> SQL.Snippet
Expand Down
2 changes: 1 addition & 1 deletion src/PostgREST/Request/ApiRequest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ import PostgREST.Request.Preferences (PreferCount (..),
PreferResolution (..),
PreferTransaction (..))

import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.ContentType as ContentType
import qualified PostgREST.Request.Preferences as Preferences

import Protolude hiding (head, toS)
Expand Down
12 changes: 6 additions & 6 deletions src/PostgREST/Request/Preferences.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,20 +9,20 @@ module PostgREST.Request.Preferences
, ToAppliedHeader(..)
) where

import qualified Data.ByteString as BS
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Network.HTTP.Types.Header as HTTP
import qualified Data.Map as Map

import Protolude


data Preferences
= Preferences
{ preferResolution :: Maybe PreferResolution
{ preferResolution :: Maybe PreferResolution
, preferRepresentation :: PreferRepresentation
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
, preferParameters :: Maybe PreferParameters
, preferCount :: Maybe PreferCount
, preferTransaction :: Maybe PreferTransaction
}

fromHeaders :: [HTTP.Header] -> Preferences
Expand Down

0 comments on commit cd30135

Please sign in to comment.