refactor: Use stronger typing for SelectItem parser

Signed-off-by: Wolfgang Walther <walther@technowledgy.de>

src/PostgREST/ApiRequest.hs

@@ -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 SelectField{selField=("*", _)} []] = Nothing
-    fstFieldName [Node ((fld, _), Nothing, Nothing, Nothing, Nothing) []] = Just fld
+    fstFieldName [Node SelectField{selField=(fld, _)} []] = Just fld
-    fstFieldName _                           = Nothing
+    fstFieldName _                                        = Nothing

src/PostgREST/ApiRequest/QueryParams.hs

@@ -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

src/PostgREST/ApiRequest/Types.hs

@@ -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]

src/PostgREST/Plan.hs

@@ -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 $
-        [] -> Node q{select=fld:select q} rForest
+          foldr (treeEntry nxtDepth)
-        _  -> Node q $
+          (Node defReadPlan{from=QualifiedIdentifier qiSchema (fst selField), relName=fst selField, relAlias=selAlias, relHint=selHint, relJoinType=selJoinType, depth=nxtDepth} [])
-              foldr (treeEntry nxtDepth)
+          fldForest:rForest
-              (Node defReadPlan{from=QualifiedIdentifier qiSchema fldName, relName=fldName, relAlias=alias, relHint=hint, relJoinType=joinType, depth=nxtDepth} [])
+    treeEntry _ (Node SelectField{..} _) (Node q rForest) = Node q{select=(selField, selCast, selAlias):select q} rForest
-              fldForest:rForest
 
 -- | Enforces the `max-rows` config on the result
 treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either ApiRequestError ReadPlanTree

src/PostgREST/Plan/ReadPlan.hs

@@ -8,10 +8,9 @@ module PostgREST.Plan.ReadPlan
 
 import Data.Tree (Tree (..))
 
-import PostgREST.ApiRequest.Types         (Alias, Depth, Hint,
+import PostgREST.ApiRequest.Types         (Alias, Cast, Depth, Field,
-                                           JoinType, LogicTree,
+                                           Hint, JoinType, LogicTree,
-                                           NodeName, OrderTerm,
+                                           NodeName, OrderTerm)
-                                           SelectItem)
 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

src/PostgREST/Query/SqlFragment.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE LambdaCase  #-}
+{-# LANGUAGE LambdaCase     #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# 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 :: QualifiedIdentifier -> (Field, Maybe Cast, Maybe Alias) -> SQL.Snippet
-pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias)
+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 =