server: remove postgres-specific code from OrderBy IR (#6150)

https://github.com/hasura/graphql-engine/pull/6150

server/src-lib/Hasura/Backends/Postgres/SQL/DML.hs

@@ -3,6 +3,7 @@ module Hasura.Backends.Postgres.SQL.DML where
 import           Hasura.Prelude
 
 import qualified Data.Aeson                         as J
+import qualified Data.Aeson.Casing                  as J
 import qualified Data.HashMap.Strict                as HM
 import qualified Data.Text                          as T
 import qualified Text.Builder                       as TB
@@ -84,6 +85,12 @@ instance ToSQL OrderType where
   toSQL OTAsc  = "ASC"
   toSQL OTDesc = "DESC"
 
+instance J.FromJSON OrderType where
+  parseJSON = J.genericParseJSON $ J.defaultOptions{J.constructorTagModifier = J.snakeCase . drop 2}
+
+instance J.ToJSON OrderType where
+  toJSON = J.genericToJSON $ J.defaultOptions{J.constructorTagModifier = J.snakeCase . drop 2}
+
 data NullsOrder
   = NFirst
   | NLast
@@ -96,6 +103,12 @@ instance ToSQL NullsOrder where
   toSQL NFirst = "NULLS FIRST"
   toSQL NLast  = "NULLS LAST"
 
+instance J.FromJSON NullsOrder where
+  parseJSON = J.genericParseJSON $ J.defaultOptions{J.constructorTagModifier = J.snakeCase . drop 1}
+
+instance J.ToJSON NullsOrder where
+  toJSON = J.genericToJSON $ J.defaultOptions{J.constructorTagModifier = J.snakeCase . drop 1}
+
 instance ToSQL OrderByExp where
   toSQL (OrderByExp l) =
     "ORDER BY" <~> (", " <+> toList l)

server/src-lib/Hasura/Backends/Postgres/Translate/Select.hs

@@ -697,8 +697,7 @@ processOrderByItems sourcePrefix' fieldAlias' similarArrayFields orderByItems =
     toOrderByExp :: OrderByItemExp 'Postgres -> S.OrderByItem
     toOrderByExp orderByItemExp =
       let OrderByItemG obTyM expAlias obNullsM = fst . snd <$> orderByItemExp
-      in S.OrderByItem (S.SEIdentifier $ toIdentifier expAlias)
-         (unOrderType <$> obTyM) (unNullsOrder <$> obNullsM)
+      in S.OrderByItem (S.SEIdentifier $ toIdentifier expAlias) obTyM obNullsM
 
     mkCursorExp :: [OrderByItemExp 'Postgres] -> S.SQLExp
     mkCursorExp orderByItemExps =
@@ -1126,7 +1125,7 @@ processConnectionSelect sourcePrefixes fieldAlias relAlias colMapping connection
 
         mkSplitCompareExp (ConnectionSplit kind v (OrderByItemG obTyM obCol _)) =
           let obAlias = mkAnnOrderByAlias thisPrefix fieldAlias similarArrayFields obCol
-              obTy = maybe S.OTAsc unOrderType obTyM
+              obTy = fromMaybe S.OTAsc obTyM
               compareOp = case (kind, obTy) of
                 (CSKAfter, S.OTAsc)   -> S.SGT
                 (CSKAfter, S.OTDesc)  -> S.SLT

server/src-lib/Hasura/GraphQL/Schema/OrderBy.hs

@@ -91,7 +91,7 @@ orderByAggregation
   :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
   => QualifiedTable
   -> SelPermInfo 'Postgres
-  -> m (Parser 'Input n [IR.OrderByItemG (IR.AnnAggregateOrderBy 'Postgres)])
+  -> m (Parser 'Input n [IR.OrderByItemG 'Postgres (IR.AnnAggregateOrderBy 'Postgres)])
 orderByAggregation table selectPermissions = do
   -- WIP NOTE
   -- there is heavy duplication between this and Select.tableAggregationFields
@@ -129,7 +129,7 @@ orderByAggregation table selectPermissions = do
       :: G.Name
       -> G.Name
       -> InputFieldsParser n [(ColumnInfo 'Postgres, OrderInfo)]
-      -> InputFieldsParser n (Maybe [IR.OrderByItemG (IR.AnnAggregateOrderBy 'Postgres)])
+      -> InputFieldsParser n (Maybe [IR.OrderByItemG 'Postgres (IR.AnnAggregateOrderBy 'Postgres)])
     parseOperator operator tableGQLName columns =
       let opText     = G.unName operator
           objectName = tableGQLName <> $$(G.litName "_") <> operator <> $$(G.litName "_order_by")
@@ -166,12 +166,12 @@ orderByOperator =
 
 -- local helpers
 
-mkOrderByItemG :: a -> OrderInfo -> IR.OrderByItemG a
+mkOrderByItemG :: a -> OrderInfo -> IR.OrderByItemG 'Postgres a
 mkOrderByItemG column (orderType, nullsOrder) =
-  IR.OrderByItemG { obiType   = Just $ IR.OrderType orderType
-               , obiColumn = column
-               , obiNulls  = Just $ IR.NullsOrder nullsOrder
-               }
+  IR.OrderByItemG { obiType   = Just orderType
+                  , obiColumn = column
+                  , obiNulls  = Just  nullsOrder
+                  }
 
 aliasToName :: G.Name -> FieldName
 aliasToName = FieldName . G.unName

server/src-lib/Hasura/RQL/DML/Types.hs

@@ -1,5 +1,7 @@
 module Hasura.RQL.DML.Types
-       ( DMLQuery(..)
+       ( OrderByExp(..)
+
+       , DMLQuery(..)
 
        , SelectG(..)
        , selectGToPairs
@@ -40,6 +42,8 @@ import           Data.Aeson.TH
 import           Instances.TH.Lift                  ()
 import           Language.Haskell.TH.Syntax         (Lift)
 
+import qualified Hasura.Backends.Postgres.SQL.DML   as PG
+
 import           Hasura.Backends.Postgres.SQL.Types
 import           Hasura.RQL.IR.BoolExp
 import           Hasura.RQL.IR.OrderBy
@@ -48,6 +52,40 @@ import           Hasura.RQL.Types.Common            hiding (ConstraintName)
 import           Hasura.SQL.Backend
 
 
+newtype OrderByExp
+  = OrderByExp { getOrderByItems :: [OrderByItem 'Postgres] }
+  deriving (Show, Eq, Lift, ToJSON)
+
+instance FromJSON OrderByExp where
+  parseJSON = \case
+    String s -> OrderByExp . pure <$> parseString s
+    Object o -> OrderByExp . pure <$> parseObject o
+    Array  a -> OrderByExp <$> for (toList a) \case
+      String s -> parseString s
+      Object o -> parseObject o
+      _        -> fail "expecting an object or string for order by"
+    _        -> fail "Expecting : array/string/object"
+    where
+      parseString s = AT.parseOnly orderByParser s `onLeft`
+        const (fail "string format for 'order_by' entry : {+/-}column Eg : +posted")
+      parseObject o =
+        OrderByItemG
+        <$> o .:? "type"
+        <*> o .:  "column"
+        <*> o .:? "nulls"
+      orderByParser =
+        OrderByItemG
+        <$> orderTypeParser
+        <*> orderColumnParser
+        <*> pure Nothing
+      orderTypeParser = choice
+        [ "+" *> pure (Just PG.OTAsc)
+        , "-" *> pure (Just PG.OTDesc)
+        , pure Nothing
+        ]
+      orderColumnParser = AT.takeText >>= orderByColFromTxt
+
+
 data DMLQuery a
   = DMLQuery !QualifiedTable a
   deriving (Show, Eq, Lift)
@@ -61,7 +99,6 @@ instance (FromJSON a) => FromJSON (DMLQuery a) where
     fail "Expected an object for query"
 
 
-
 data SelectG a b c
   = SelectG
   { sqColumns :: ![a]                -- Postgres columns and relationships

server/src-lib/Hasura/RQL/IR/OrderBy.hs

@@ -1,72 +1,23 @@
 module Hasura.RQL.IR.OrderBy
-  ( OrderType(..)
-  , NullsOrder(..)
-  , OrderByExp(..)
+  ( OrderByCol(..)
   , OrderByItemG(..)
   , OrderByItem
-  , OrderByCol(..)
+  -- used by RQL.DML.Types
+  , orderByColFromTxt
   ) where
 
 import           Hasura.Prelude
 
-import qualified Data.Attoparsec.Text             as Atto
-import qualified Data.Attoparsec.Types            as AttoT
-import qualified Data.Text                        as T
+import qualified Data.Text                  as T
 
 import           Data.Aeson
 import           Data.Aeson.Casing
-import           Data.Aeson.TH
-import           Instances.TH.Lift                ()
-import           Language.Haskell.TH.Syntax       (Lift)
+import           Instances.TH.Lift          ()
+import           Language.Haskell.TH.Syntax (Lift)
 
-import qualified Hasura.Backends.Postgres.SQL.DML as S
-
-import           Hasura.RQL.Instances             ()
+import           Hasura.RQL.Instances       ()
 import           Hasura.RQL.Types.Common
-
-
--- order type
-
-newtype OrderType
-  = OrderType { unOrderType :: S.OrderType }
-  deriving (Show, Eq, Lift, Generic)
-instance Hashable OrderType
-
-instance FromJSON OrderType where
-  parseJSON =
-    fmap OrderType . f
-    where f = $(mkParseJSON
-                defaultOptions{constructorTagModifier = snakeCase . drop 2}
-                ''S.OrderType)
-
-
--- nulls order
-
-newtype NullsOrder
-  = NullsOrder { unNullsOrder :: S.NullsOrder }
-  deriving (Show, Eq, Lift, Generic)
-instance Hashable NullsOrder
-
-instance FromJSON NullsOrder where
-  parseJSON =
-    fmap NullsOrder . f
-    where f = $(mkParseJSON
-                defaultOptions{constructorTagModifier = snakeCase . drop 1}
-                ''S.NullsOrder)
-
-instance ToJSON OrderType where
-  toJSON =
-    f . unOrderType
-    where f = $(mkToJSON
-                defaultOptions{constructorTagModifier = snakeCase . drop 2}
-                ''S.OrderType)
-
-instance ToJSON NullsOrder where
-  toJSON =
-    f . unNullsOrder
-    where f = $(mkToJSON
-                defaultOptions{constructorTagModifier = snakeCase . drop 1}
-                ''S.NullsOrder)
+import           Hasura.SQL.Backend
 
 
 -- order by col
@@ -111,52 +62,21 @@ orderByColFromTxt =
 
 -- order by item
 
-data OrderByItemG a
+data OrderByItemG (b :: BackendType) a
   = OrderByItemG
-  { obiType   :: !(Maybe OrderType)
+  { obiType   :: !(Maybe (BasicOrderType b))
   , obiColumn :: !a
-  , obiNulls  :: !(Maybe NullsOrder)
-  } deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Generic)
-instance (Hashable a) => Hashable (OrderByItemG a)
+  , obiNulls  :: !(Maybe (NullsOrderType b))
+  } deriving (Functor, Foldable, Traversable, Generic)
+deriving instance (Backend b, Show a) => Show (OrderByItemG b a)
+deriving instance (Backend b, Eq a)   => Eq   (OrderByItemG b a)
+deriving instance (Backend b, Lift a) => Lift (OrderByItemG b a)
+instance (Backend b, Hashable a) => Hashable (OrderByItemG b a)
 
-type OrderByItem = OrderByItemG OrderByCol
+type OrderByItem b = OrderByItemG b OrderByCol
 
-$(deriveToJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''OrderByItemG)
+instance (Backend b, FromJSON a) => FromJSON (OrderByItemG b a) where
+  parseJSON = genericParseJSON (aesonPrefix snakeCase){omitNothingFields=True}
 
--- Can either be string / object
-instance FromJSON OrderByItem where
-  parseJSON (String t) =
-    case Atto.parseOnly orderByParser t of
-    Right r -> return r
-    Left _  ->
-      fail "string format for 'order_by' entry : {+/-}column Eg : +posted"
-
-  parseJSON (Object o) =
-    OrderByItemG
-    <$> o .:? "type"
-    <*> o .:  "column"
-    <*> o .:? "nulls"
-  parseJSON _ = fail "expecting an object or string for order by"
-
-newtype OrderByExp
-  = OrderByExp { getOrderByItems :: [OrderByItem] }
-  deriving (Show, Eq, ToJSON, Lift)
-
-instance FromJSON OrderByExp where
-  parseJSON v@(String _) =
-    OrderByExp . (:[]) <$> parseJSON v
-  parseJSON v@(Array _) =
-    OrderByExp <$> parseJSON v
-  parseJSON v@(Object _) =
-    OrderByExp . (:[]) <$> parseJSON v
-  parseJSON _ =
-    fail "Expecting : array/string/object"
-
-orderByParser :: AttoT.Parser Text OrderByItem
-orderByParser =
-  OrderByItemG <$> otP <*> colP <*> return Nothing
-  where
-    otP  = ("+" *> return (Just $ OrderType S.OTAsc))
-           <|> ("-" *> return (Just $ OrderType S.OTDesc))
-           <|> return Nothing
-    colP = Atto.takeText >>= orderByColFromTxt
+instance (Backend b, ToJSON a) => ToJSON (OrderByItemG b a) where
+  toJSON = genericToJSON (aesonPrefix snakeCase){omitNothingFields=True}

server/src-lib/Hasura/RQL/IR/Select.hs

@@ -64,7 +64,7 @@ traverseAnnOrderByElement f = \case
     <$> traverseAnnBoolExp f annBoolExp
     <*> pure annAggOb
 
-type AnnOrderByItemG b v = OrderByItemG (AnnOrderByElement b v)
+type AnnOrderByItemG b v = OrderByItemG b (AnnOrderByElement b v)
 
 traverseAnnOrderByItem
   :: (Applicative f)
@@ -75,7 +75,7 @@ traverseAnnOrderByItem f =
 type AnnOrderByItem b = AnnOrderByItemG b (SQLExp b)
 
 type OrderByItemExp b =
-  OrderByItemG (AnnOrderByElement b (SQLExp b), (PG.Alias, (SQLExp b)))
+  OrderByItemG b (AnnOrderByElement b (SQLExp b), (PG.Alias, (SQLExp b)))
 
 data AnnRelationSelectG (b :: BackendType) a
   = AnnRelationSelectG
@@ -435,7 +435,7 @@ data ConnectionSplit (b :: BackendType) v
   = ConnectionSplit
   { _csKind    :: !ConnectionSplitKind
   , _csValue   :: !v
-  , _csOrderBy :: !(OrderByItemG (AnnOrderByElementG b ()))
+  , _csOrderBy :: !(OrderByItemG b (AnnOrderByElementG b ()))
   } deriving (Functor, Generic, Foldable, Traversable)
 instance (Hashable v) => Hashable (ConnectionSplit 'Postgres v)
 

server/src-lib/Hasura/RQL/Types/Common.hs

@@ -114,23 +114,39 @@ class
   ( Show (TableName b)
   , Show (ConstraintName b)
   , Show (Column b)
+  , Show (BasicOrderType b)
+  , Show (NullsOrderType b)
   , Eq (TableName b)
   , Eq (ConstraintName b)
   , Eq (Column b)
+  , Eq (BasicOrderType b)
+  , Eq (NullsOrderType b)
   , Lift (TableName b)
-  , NFData (TableName b)
+  , Lift (BasicOrderType b)
+  , Lift (NullsOrderType b)
   , Cacheable (TableName b)
-  , Hashable (TableName b)
   , Data (TableName b)
+  , Hashable (BasicOrderType b)
+  , Hashable (NullsOrderType b)
+  , Hashable (TableName b)
+  , NFData (TableName b)
+  , FromJSON (BasicOrderType b)
+  , FromJSON (NullsOrderType b)
+  , ToJSON (BasicOrderType b)
+  , ToJSON (NullsOrderType b)
   , Typeable b
   ) => Backend (b :: BackendType) where
   type TableName      b :: Type
   type ConstraintName b :: Type
+  type BasicOrderType b :: Type
+  type NullsOrderType b :: Type
   type Column         b :: Type
 
 instance Backend 'Postgres where
   type TableName      'Postgres = PG.QualifiedTable
   type ConstraintName 'Postgres = PG.ConstraintName
+  type BasicOrderType 'Postgres = PG.OrderType
+  type NullsOrderType 'Postgres = PG.NullsOrder
   type Column         'Postgres = PG.PGCol