refactor: Use stronger typing for SelectItem parser

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>
This commit is contained in:
Wolfgang Walther
2022-10-27 21:54:44 +02:00
committed by Wolfgang Walther
parent 772d3c4e01
commit 2289defe4b
6 changed files with 85 additions and 31 deletions
+5 -4
View File
@@ -51,7 +51,8 @@ import PostgREST.ApiRequest.Preferences (PreferCount (..),
PreferTransaction (..))
import PostgREST.ApiRequest.QueryParams (QueryParams (..))
import PostgREST.ApiRequest.Types (ApiRequestError (..),
RangeError (..), SelectItem)
RangeError (..),
SelectItem (..))
import PostgREST.Config (AppConfig (..),
OpenAPIMode (..))
import PostgREST.MediaType (MTPlanAttrs (..),
@@ -528,6 +529,6 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType target QueryParams{qs
returnsScalar _ = False
fstFieldName :: [Tree SelectItem] -> Maybe FieldName
fstFieldName [Node (("*", _), Nothing, Nothing, Nothing, Nothing) []] = Nothing
fstFieldName [Node ((fld, _), Nothing, Nothing, Nothing, Nothing) []] = Just fld
fstFieldName _ = Nothing
fstFieldName [Node SelectField{selField=("*", _)} []] = Nothing
fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld
fstFieldName _ = Nothing
+46 -5
View File
@@ -53,7 +53,7 @@ import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
Operation (..),
OrderDirection (..),
OrderNulls (..), OrderTerm (..),
QPError (..), SelectItem,
QPError (..), SelectItem (..),
SimpleOperator (..), SingleVal,
TrileanVal (..))
@@ -73,6 +73,7 @@ import Protolude hiding (try)
-- >>> deriving instance Show JsonOperation
-- >>> deriving instance Show Filter
-- >>> deriving instance Show JoinType
-- >>> deriving instance Show SelectItem
data QueryParams =
QueryParams
@@ -113,7 +114,7 @@ data QueryParams =
-- 'select' is a reserved parameter that selects the fields to be returned:
--
-- >>> qsSelect <$> parse "select=name,location"
-- Right [Node {rootLabel = (("name",[]),Nothing,Nothing,Nothing,Nothing), subForest = []},Node {rootLabel = (("location",[]),Nothing,Nothing,Nothing,Nothing), subForest = []}]
-- Right [Node {rootLabel = SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing}, subForest = []},Node {rootLabel = SelectField {selField = ("location",[]), selCast = Nothing, selAlias = Nothing}, subForest = []}]
--
-- Filters are parameters whose value contains an operator, separated by a '.' from its value:
--
@@ -368,13 +369,33 @@ pField = lexeme $ (,) <$> pFieldName <*> P.option [] pJsonPath
aliasSeparator :: Parser ()
aliasSeparator = char ':' >> notFollowedBy (char ':')
-- |
-- Parse regular fields in select
--
-- >>> P.parse pRelationSelect "" "rel(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Nothing, selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "alias:rel(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Just "alias", selHint = Nothing, selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "rel!hint(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Just "hint", selJoinType = Nothing})
--
-- >>> P.parse pRelationSelect "" "rel!inner(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Nothing, selJoinType = Just JTInner})
--
-- >>> P.parse pRelationSelect "" "rel!hint!inner(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Nothing, selHint = Just "hint", selJoinType = Just JTInner})
--
-- >>> P.parse pRelationSelect "" "alias:rel!inner!hint(*)"
-- Right (SelectRelation {selField = ("rel",[]), selAlias = Just "alias", selHint = Just "hint", selJoinType = Just JTInner})
pRelationSelect :: Parser SelectItem
pRelationSelect = lexeme $ try ( do
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
prm1 <- optionMaybe pEmbedParam
prm2 <- optionMaybe pEmbedParam
return (fld, Nothing, alias, embedParamHint prm1 <|> embedParamHint prm2, embedParamJoin prm1 <|> embedParamJoin prm2)
return $ SelectRelation fld alias (embedParamHint prm1 <|> embedParamHint prm2) (embedParamJoin prm1 <|> embedParamJoin prm2)
)
where
pEmbedParam :: Parser EmbedParam
@@ -390,6 +411,26 @@ pRelationSelect = lexeme $ try ( do
Just (EPJoinType jt) -> Just jt
_ -> Nothing
-- |
-- Parse regular fields in select
--
-- >>> P.parse pFieldSelect "" "name"
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name->jsonpath"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Nothing, selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "name::cast"
-- Right (SelectField {selField = ("name",[]), selCast = Just "cast", selAlias = Nothing})
--
-- >>> P.parse pFieldSelect "" "alias:name"
-- Right (SelectField {selField = ("name",[]), selCast = Nothing, selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "alias:name->jsonpath::cast"
-- Right (SelectField {selField = ("name",[JArrow {jOp = JKey {jVal = "jsonpath"}}]), selCast = Just "cast", selAlias = Just "alias"})
--
-- >>> P.parse pFieldSelect "" "*"
-- Right (SelectField {selField = ("*",[]), selCast = Nothing, selAlias = Nothing})
pFieldSelect :: Parser SelectItem
pFieldSelect = lexeme $
try (
@@ -397,11 +438,11 @@ pFieldSelect = lexeme $
alias <- optionMaybe ( try(pFieldName <* aliasSeparator) )
fld <- pField
cast' <- optionMaybe (string "::" *> many pIdentifierChar)
return (fld, toS <$> cast', alias, Nothing, Nothing)
return $ SelectField fld (toS <$> cast') alias
)
<|> do
s <- pStar
return ((s, []), Nothing, Nothing, Nothing, Nothing)
return $ SelectField (s, []) Nothing Nothing
pOpExpr :: Parser SingleVal -> Parser OpExpr
pOpExpr pSVal = try ( string "not" *> pDelimiter *> (OpExpr True <$> pOperation)) <|> OpExpr False <$> pOperation
+14 -2
View File
@@ -28,7 +28,7 @@ module PostgREST.ApiRequest.Types
, TrileanVal(..)
, SimpleOperator(..)
, FtsOperator(..)
, SelectItem
, SelectItem(..)
) where
import PostgREST.MediaType (MediaType (..))
@@ -39,7 +39,19 @@ import PostgREST.SchemaCache.Relationship (Relationship)
import Protolude
-- | The select value in `/tbl?select=alias:field::cast`
type SelectItem = (Field, Maybe Cast, Maybe Alias, Maybe Hint, Maybe JoinType)
data SelectItem
= SelectField
{ selField :: Field
, selCast :: Maybe Cast
, selAlias :: Maybe Alias
}
| SelectRelation
{ selField :: Field
, selAlias :: Maybe Alias
, selHint :: Maybe Hint
, selJoinType :: Maybe JoinType
}
deriving (Eq)
data ApiRequestError
= AmbiguousRelBetween Text Text [Relationship]
+6 -7
View File
@@ -109,14 +109,13 @@ initReadRequest qi@QualifiedIdentifier{..} =
rootDepth = 0
defReadPlan = ReadPlan [] (QualifiedIdentifier mempty mempty) Nothing [] [] allRange mempty Nothing [] Nothing mempty Nothing Nothing rootDepth
treeEntry :: Depth -> Tree SelectItem -> ReadPlanTree -> ReadPlanTree
treeEntry depth (Node fld@((fldName, _),_,alias, hint, joinType) fldForest) (Node q rForest) =
treeEntry depth (Node SelectRelation{..} fldForest) (Node q rForest) =
let nxtDepth = succ depth in
case fldForest of
[] -> Node q{select=fld:select q} rForest
_ -> Node q $
foldr (treeEntry nxtDepth)
(Node defReadPlan{from=QualifiedIdentifier qiSchema fldName, relName=fldName, relAlias=alias, relHint=hint, relJoinType=joinType, depth=nxtDepth} [])
fldForest:rForest
Node q $
foldr (treeEntry nxtDepth)
(Node defReadPlan{from=QualifiedIdentifier qiSchema (fst selField), relName=fst selField, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
fldForest:rForest
treeEntry _ (Node SelectField{..} _) (Node q rForest) = Node q{select=(selField, selCast, selAlias):select q} rForest
-- | Enforces the `max-rows` config on the result
treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
+5 -6
View File
@@ -8,10 +8,9 @@ module PostgREST.Plan.ReadPlan
import Data.Tree (Tree (..))
import PostgREST.ApiRequest.Types (Alias, Depth, Hint,
JoinType, LogicTree,
NodeName, OrderTerm,
SelectItem)
import PostgREST.ApiRequest.Types (Alias, Cast, Depth, Field,
Hint, JoinType, LogicTree,
NodeName, OrderTerm)
import PostgREST.RangeQuery (NonnegRange)
import PostgREST.SchemaCache.Identifiers (FieldName,
QualifiedIdentifier)
@@ -29,7 +28,7 @@ data JoinCondition =
deriving (Eq)
data ReadPlan = ReadPlan
{ select :: [SelectItem]
{ select :: [(Field, Maybe Cast, Maybe Alias)]
, from :: QualifiedIdentifier
, fromAlias :: Maybe Alias
, where_ :: [LogicTree]
@@ -50,4 +49,4 @@ data ReadPlan = ReadPlan
-- First level FieldNames(e.g get a,b from /table?select=a,b,other(c,d))
fstFieldNames :: ReadPlanTree -> [FieldName]
fstFieldNames (Node ReadPlan{select} _) =
fst . (\(f, _, _, _, _) -> f) <$> select
fst . (\(f, _, _) -> f) <$> select
+9 -7
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : PostgREST.Query.SqlFragment
Description : Helper functions for PostgREST.QueryBuilder.
@@ -56,7 +57,8 @@ import Control.Arrow ((***))
import Data.Foldable (foldr1)
import Text.InterpolatedString.Perl6 (qc)
import PostgREST.ApiRequest.Types (Alias, Field, Filter (..),
import PostgREST.ApiRequest.Types (Alias, Cast, Field,
Filter (..),
FtsOperator (..),
JsonOperand (..),
JsonOperation (..),
@@ -66,7 +68,7 @@ import PostgREST.ApiRequest.Types (Alias, Field, Filter (..),
Operation (..),
OrderDirection (..),
OrderNulls (..),
OrderTerm (..), SelectItem,
OrderTerm (..),
SimpleOperator (..),
TrileanVal (..))
import PostgREST.MediaType (MTPlanFormat (..),
@@ -233,12 +235,12 @@ pgFmtField table (c, []) = SQL.sql (pgFmtColumn table c)
-- "operator does not exist: json = unknown"
pgFmtField table (c, jp) = SQL.sql ("to_jsonb(" <> pgFmtColumn table c <> ")") <> pgFmtJsonPath jp
pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
pgFmtSelectItem :: QualifiedIdentifier -> (Field, Maybe Cast, Maybe Alias) -> SQL.Snippet
pgFmtSelectItem table (f@(fName, jp), Nothing, alias) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
-- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc.
-- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting.
-- Not quoting should be fine, we validate the input on Parsers.
pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
pgFmtSelectItem table (f@(fName, jp), Just cast, alias) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias)
pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet
pgFmtOrderTerm qi ot =