test: doctest for addNullEmbedFilters

src/PostgREST/ApiRequest/QueryParams.hs

@@ -60,12 +60,6 @@ import PostgREST.ApiRequest.Types (EmbedParam (..), EmbedPath, Field,
 
 import Protolude hiding (try)
 
-
--- $setup
--- Setup for doctests
--- >>> import Text.Pretty.Simple (pPrint)
--- >>> deriving instance Show QPError
-
 data QueryParams =
  QueryParams
  { qsCanonical :: ByteString

src/PostgREST/ApiRequest/Types.hs

@@ -86,12 +86,15 @@ data ApiRequestError
  | UnacceptableSchema [Text]
  | UnsupportedMethod ByteString
  | ColumnNotFound Text Text
+ deriving Show
 
 data QPError = QPError Text Text
+ deriving Show
 data RangeError
  = NegativeLimit
  | LowerGTUpper
  | OutOfBounds Text Text
+ deriving Show
 
 type NodeName = Text
 type Depth = Integer

src/PostgREST/Plan.hs

@@ -82,6 +82,10 @@ import qualified PostgREST.ApiRequest.QueryParams as QueryParams
 
 import Protolude hiding (from)
 
+-- $setup
+-- Setup for doctests
+-- >>> import Data.Ranged.Ranges (fullRange)
+
 data WrappedReadPlan = WrappedReadPlan {
  wrReadPlan :: ReadPlanTree
 , wrTxMode :: SQL.Mode
@@ -552,24 +556,92 @@ addRelatedOrders (Node rp@ReadPlan{order,from} forest) = do
  Nothing ->
  Left $ NotEmbedded otRelation
 
--- Searches for null filters on embeds, e.g. `clients` on /projects?select=*,clients()&clients=not.is.null.
--- If these are found, it changes the filter to use the internal aggregate name(`projects_clients_1`) so the filter can succeed.
--- It fails if operators other than is.null or not.is.null are used.
+-- | Searches for null filters on embeds, e.g. `projects=not.is.null` on `GET /clients?select=*,projects(*)&projects=not.is.null`
+--
+-- Setup:
+--
+-- >>> let nullOp = OpExpr True (Is TriNull)
+-- >>> let nonNullOp = OpExpr False (Is TriNull)
+-- >>> let notEqOp = OpExpr True (Op OpNotEqual "val")
+-- >>> :{
+-- -- this represents the `projects(*)` part on `/clients?select=*,projects(*)`
+-- let
+-- subForestPlan =
+-- [
+-- Node {
+-- rootLabel = ReadPlan {
+-- select = [], -- there will be fields at this stage but we just omit them for brevity
+-- from = QualifiedIdentifier {qiSchema = "test", qiName = "projects"},
+-- fromAlias = Just "projects_1", where_ = [], order = [], range_ = fullRange,
+-- relName = "projects",
+-- relToParent = Nothing,
+-- relJoinConds = [],
+-- relAlias = Nothing, relAggAlias = "clients_projects_1", relHint = Nothing, relJoinType = Nothing, relIsSpread = False, depth = 1
+-- },
+-- subForest = []
+-- }
+-- ]
+-- :}
+--
+-- >>> :{
+-- -- this represents the full URL `/clients?select=*,projects(*)&projects=not.is.null`, if subForst takes the above subForestPlan and nullOp
+-- let
+-- readPlanTree op subForst =
+-- Node {
+-- rootLabel = ReadPlan {
+-- select = [], -- there will be fields at this stage but we just omit them for brevity
+-- from = QualifiedIdentifier { qiSchema = "test", qiName = "clients"},
+-- fromAlias = Nothing,
+-- where_ = [
+-- CoercibleStmnt (
+-- CoercibleFilter {
+-- field = CoercibleField {cfName = "projects", cfJsonPath = [], cfIRType = "", cfTransform = Nothing, cfDefault = Nothing},
+-- opExpr = op
+-- }
+-- )
+-- ],
+-- order = [], range_ = fullRange, relName = "clients", relToParent = Nothing, relJoinConds = [], relAlias = Nothing, relAggAlias = "", relHint = Nothing,
+-- relJoinType = Nothing, relIsSpread = False, depth = 0
+-- },
+-- subForest = subForst
+-- }
+-- :}
+--
+-- Don't do anything to the filter if there's no embedding (a subtree) on projects. Assume it's a normal filter.
+--
+-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp [])
+-- Right [CoercibleStmnt (CoercibleFilter {field = CoercibleField {cfName = "projects", cfJsonPath = [], cfIRType = "", cfTransform = Nothing, cfDefault = Nothing}, opExpr = OpExpr True (Is TriNull)})]
+--
+-- If there's an embedding on projects, then change the filter to use the internal aggregate name (`clients_projects_1`) so the filter can succeed later.
+--
+-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nullOp subForestPlan)
+-- Right [CoercibleStmnt (CoercibleFilterNullEmbed True "clients_projects_1")]
+--
+-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree nonNullOp subForestPlan)
+-- Right [CoercibleStmnt (CoercibleFilterNullEmbed False "clients_projects_1")]
+--
+-- It fails if operators other than is.null or not.is.null on the embedding are used.
+--
+-- >>> ReadPlan.where_ . rootLabel <$> addNullEmbedFilters (readPlanTree notEqOp subForestPlan)
+-- Left (UnacceptableFilter "projects")
 addNullEmbedFilters :: ReadPlanTree -> Either ApiRequestError ReadPlanTree
-addNullEmbedFilters (Node rp@ReadPlan{where_=oldLogic} forest) = do
- let readPlans = rootLabel <$> forest
- newLogic <- getFilters readPlans `traverse` oldLogic
+addNullEmbedFilters (Node rp@ReadPlan{where_=curLogic} forest) = do
+ let forestReadPlans = rootLabel <$> forest
+ newLogic <- newNullFilters forestReadPlans `traverse` curLogic
  Node rp{ReadPlan.where_= newLogic} <$> (addNullEmbedFilters `traverse` forest)
  where
- getFilters :: [ReadPlan] -> CoercibleLogicTree -> Either ApiRequestError CoercibleLogicTree
- getFilters rPlans (CoercibleExpr b lOp trees) = CoercibleExpr b lOp <$> (getFilters rPlans `traverse` trees)
- getFilters rPlans flt@(CoercibleStmnt (CoercibleFilter (CoercibleField fld [] _ _ _) opExpr)) =
- let foundRP = find (\ReadPlan{relName, relAlias} -> fld == fromMaybe relName relAlias) rPlans in
- case (foundRP, opExpr) of
- (Just ReadPlan{relAggAlias}, OpExpr b (Is TriNull)) -> Right $ CoercibleStmnt $ CoercibleFilterNullEmbed b relAggAlias
- (Just ReadPlan{relName}, _) -> Left $ UnacceptableFilter relName
- _ -> Right flt
- getFilters _ flt@(CoercibleStmnt _) = Right flt
+ newNullFilters :: [ReadPlan] -> CoercibleLogicTree -> Either ApiRequestError CoercibleLogicTree
+ newNullFilters rPlans = \case
+ (CoercibleExpr b lOp trees) ->
+ CoercibleExpr b lOp <$> (newNullFilters rPlans `traverse` trees)
+ flt@(CoercibleStmnt (CoercibleFilter (CoercibleField fld [] _ _ _) opExpr)) ->
+ let foundRP = find (\ReadPlan{relName, relAlias} -> fld == fromMaybe relName relAlias) rPlans in
+ case (foundRP, opExpr) of
+ (Just ReadPlan{relAggAlias}, OpExpr b (Is TriNull)) -> Right $ CoercibleStmnt $ CoercibleFilterNullEmbed b relAggAlias
+ (Just ReadPlan{relName}, _) -> Left $ UnacceptableFilter relName
+ _ -> Right flt
+ flt@(CoercibleStmnt _) ->
+ Right flt
 
 addRanges :: ApiRequest -> ReadPlanTree -> Either ApiRequestError ReadPlanTree
 addRanges ApiRequest{..} rReq =

src/PostgREST/SchemaCache/Routine.hs

@@ -29,18 +29,18 @@ import Protolude
 data PgType
  = Scalar QualifiedIdentifier
  | Composite QualifiedIdentifier Bool -- True if the composite is a domain alias(used to work around a bug in pg 11 and 12, see QueryBuilder.hs)
- deriving (Eq, Ord, Generic, JSON.ToJSON)
+ deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
 
 data RetType
  = Single PgType
  | SetOf PgType
- deriving (Eq, Ord, Generic, JSON.ToJSON)
+ deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
 
 data FuncVolatility
  = Volatile
  | Stable
  | Immutable
- deriving (Eq, Ord, Generic, JSON.ToJSON)
+ deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
 
 data Routine = Function
  { pdSchema :: Schema
@@ -52,7 +52,7 @@ data Routine = Function
  , pdHasVariadic :: Bool
  , pdIsoLvl :: Maybe SQL.IsolationLevel
  }
- deriving (Eq, Generic)
+ deriving (Eq, Show, Generic)
 -- need to define JSON manually bc SQL.IsolationLevel doesn't have a JSON instance(and we can't define one for that type without getting a compiler error)
 instance JSON.ToJSON Routine where
  toJSON (Function sch nam desc params ret vol hasVar _) = JSON.object
@@ -72,7 +72,7 @@ data RoutineParam = RoutineParam
  , ppReq :: Bool
  , ppVar :: Bool
  }
- deriving (Eq, Ord, Generic, JSON.ToJSON)
+ deriving (Eq, Show, Ord, Generic, JSON.ToJSON)
 
 -- Order by least number of params in the case of overloaded functions
 instance Ord Routine where

test/doc/Main.hs

@@ -11,11 +11,13 @@ main =
  [ "-XOverloadedStrings"
  , "-XNoImplicitPrelude"
  , "-XStandaloneDeriving"
+ , "-XDuplicateRecordFields"
  , "-isrc"
  , "src/PostgREST/Query/SqlFragment.hs"
  , "src/PostgREST/ApiRequest/Preferences.hs"
  , "src/PostgREST/ApiRequest/QueryParams.hs"
  , "src/PostgREST/Error.hs"
  , "src/PostgREST/MediaType.hs"
  , "src/PostgREST/Config.hs"
+ , "src/PostgREST/Plan.hs"
  ]