WIP

flipstone · Feb 26, 2024 · 6bb9e81 · 6bb9e81
1 parent 04c97b5
commit 6bb9e81
Show file tree

Hide file tree

Showing 28 changed files with 258 additions and 137 deletions.
diff --git a/orville-postgresql/src/Orville/PostgreSQL.hs b/orville-postgresql/src/Orville/PostgreSQL.hs
@@ -1,5 +1,5 @@
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -205,6 +205,7 @@ module Orville.PostgreSQL
   , FieldDefinition.fieldOfType
   , FieldDefinition.fieldColumnName
   , FieldDefinition.fieldColumnReference
+  , FieldDefinition.fieldColumnReferenceWithAlias
   , FieldDefinition.fieldName
   , FieldDefinition.setFieldName
   , FieldDefinition.fieldDescription
@@ -285,6 +286,7 @@ module Orville.PostgreSQL
   , Expr.descendingOrder
   , Expr.descendingOrderWith
   , FieldDefinition.orderByField
+  , FieldDefinition.orderByFieldWithAlias
   , Expr.orderByColumnName
   , Expr.andExpr
   , Expr.orExpr

diff --git a/orville-postgresql/src/Orville/PostgreSQL/AutoMigration.hs b/orville-postgresql/src/Orville/PostgreSQL/AutoMigration.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE RankNTypes #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -690,7 +690,7 @@ mkAddAlterColumnActions relationDesc fieldDef =
                   || (Orville.sqlTypeMaximumLength sqlType /= PgCatalog.pgAttributeMaxLength attr)
 
               columnName =
-                Orville.fieldColumnName fieldDef
+                Orville.fieldColumnName Nothing fieldDef
 
               dataType =
                 Orville.sqlTypeExpr sqlType
@@ -709,7 +709,7 @@ mkAddAlterColumnActions relationDesc fieldDef =
 
               alterNullability = do
                 guard nullabilityIsChanged
-                [Expr.alterColumnNullability (Orville.fieldColumnName fieldDef) nullabilityAction]
+                [Expr.alterColumnNullability columnName nullabilityAction]
 
               maybeExistingDefault =
                 PgCatalog.lookupAttributeDefault attr relationDesc
@@ -1192,7 +1192,7 @@ currentNamespaceQuery =
             -- put it in quotes it tries to treat it as a regular column name,
             -- which then can't be found as a column in the query.
             (RawSql.unsafeSqlExpression "current_schema")
-            (Orville.fieldColumnName PgCatalog.namespaceNameField)
+            (Orville.fieldColumnName Nothing PgCatalog.namespaceNameField)
         ]
     )
     Nothing

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Execution/Sequence.hs b/orville-postgresql/src/Orville/PostgreSQL/Execution/Sequence.hs
@@ -1,5 +1,5 @@
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -66,7 +66,7 @@ selectInt64Value caller valueExpression = do
       Expr.queryExpr
         (Expr.selectClause (Expr.selectExpr Nothing))
         ( Expr.selectDerivedColumns
-            [Expr.deriveColumnAs valueExpression (Expr.columnName "result")]
+            [Expr.deriveColumnAs valueExpression (Expr.aliasQualifyColumn Nothing (Expr.columnName "result"))]
         )
         Nothing
 

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/ColumnDefinition.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/ColumnDefinition.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -21,7 +21,7 @@ where
 import qualified Data.Maybe as Maybe
 
 import Orville.PostgreSQL.Expr.DataType (DataType)
-import Orville.PostgreSQL.Expr.Name (ColumnName)
+import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified)
 import Orville.PostgreSQL.Expr.ValueExpression (ValueExpression)
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 
@@ -49,7 +49,7 @@ newtype ColumnDefinition
 -}
 columnDefinition ::
   -- | The name the resulting column should have.
-  ColumnName ->
+  Qualified ColumnName ->
   -- | The SQL type of the column.
   DataType ->
   -- | The constraint on the column, if any.

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/Count.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/Count.hs
@@ -1,5 +1,5 @@
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -13,7 +13,7 @@ module Orville.PostgreSQL.Expr.Count
   )
 where
 
-import Orville.PostgreSQL.Expr.Name (ColumnName, FunctionName, functionName)
+import Orville.PostgreSQL.Expr.Name (ColumnName, FunctionName, Qualified, functionName)
 import Orville.PostgreSQL.Expr.ValueExpression (ValueExpression, columnReference, functionCall)
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 
@@ -44,6 +44,6 @@ count1 =
 
 @since 1.0.0.0
 -}
-countColumn :: ColumnName -> ValueExpression
+countColumn :: Qualified ColumnName -> ValueExpression
 countColumn =
   count . columnReference
diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/GroupBy.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/GroupBy.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -18,7 +18,7 @@ where
 
 import Data.List.NonEmpty (NonEmpty)
 
-import Orville.PostgreSQL.Expr.Name (ColumnName)
+import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified)
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 
 {- |
@@ -83,6 +83,6 @@ appendGroupByExpr (GroupByExpr a) (GroupByExpr b) =
 
 @since 1.0.0.0
 -}
-groupByColumnsExpr :: NonEmpty ColumnName -> GroupByExpr
+groupByColumnsExpr :: NonEmpty (Qualified ColumnName) -> GroupByExpr
 groupByColumnsExpr =
   GroupByExpr . RawSql.intercalate RawSql.commaSpace
diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/Insert.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/Insert.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -95,7 +95,7 @@ parens and commas are used to separate.
 
 @since 1.0.0.0
 -}
-insertColumnList :: [ColumnName] -> InsertColumnList
+insertColumnList :: [Qualified ColumnName] -> InsertColumnList
 insertColumnList columnNames =
   InsertColumnList $
     RawSql.leftParen

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/Internal/Name/Qualified.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/Internal/Name/Qualified.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -12,16 +12,32 @@ module Orville.PostgreSQL.Expr.Internal.Name.Qualified
   , qualifyTable
   , qualifySequence
   , qualifyColumn
+  , Alias
+  , aliasQualifyColumn
+  , alias
   )
 where
 
 import Orville.PostgreSQL.Expr.Internal.Name.ColumnName (ColumnName)
-import Orville.PostgreSQL.Expr.Internal.Name.Identifier (IdentifierExpression (toIdentifier))
+import Orville.PostgreSQL.Expr.Internal.Name.Identifier (IdentifierExpression (toIdentifier), Identifier, identifier)
 import Orville.PostgreSQL.Expr.Internal.Name.SchemaName (SchemaName)
 import Orville.PostgreSQL.Expr.Internal.Name.SequenceName (SequenceName)
 import Orville.PostgreSQL.Expr.Internal.Name.TableName (TableName)
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 
+newtype Alias
+  = Alias Identifier
+  deriving
+    ( -- | @since 1.1.0.0
+      RawSql.SqlExpression
+    , -- | @since 1.1.0.0
+      IdentifierExpression
+    )
+
+alias :: String -> Alias
+alias =
+  Alias . identifier
+
 {- |
 Type to represent a qualified SQL name. E.G.
 
@@ -82,6 +98,14 @@ qualifyColumn mbSchemaName tableName unqualifiedName =
     . RawSql.unsafeFromRawSql
     $ RawSql.toRawSql (toIdentifier tableName) <> RawSql.dot <> RawSql.toRawSql (toIdentifier unqualifiedName)
 
+aliasQualifyColumn :: Maybe Alias -> ColumnName -> Qualified ColumnName
+aliasQualifyColumn mbAliasName unqualifiedName =
+  Qualified $ case mbAliasName of
+    Nothing ->
+      RawSql.toRawSql $ toIdentifier unqualifiedName
+    Just aliasName ->
+      RawSql.toRawSql (toIdentifier aliasName) <> RawSql.dot <> RawSql.toRawSql (toIdentifier unqualifiedName)
+
 -- Note: Not everything actually makes sense to be qualified by _only_ a schema name, such as
 -- columns, as in 'qualifyColumn'. But this does give us a nice uniform way to provide the
 -- functionality in those more type restricted scenarios.

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/OrderBy.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/OrderBy.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -25,7 +25,7 @@ where
 
 import qualified Data.List.NonEmpty as NEL
 
-import Orville.PostgreSQL.Expr.Name (ColumnName)
+import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified)
 import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
 
 {- |
@@ -83,11 +83,11 @@ appendOrderByExpr (OrderByExpr a) (OrderByExpr b) =
 
 @since 1.0.0.0
 -}
-orderByColumnsExpr :: NEL.NonEmpty (ColumnName, OrderByDirection) -> OrderByExpr
+orderByColumnsExpr :: NEL.NonEmpty (Qualified ColumnName, OrderByDirection) -> OrderByExpr
 orderByColumnsExpr =
   OrderByExpr . RawSql.intercalate RawSql.commaSpace . fmap columnOrdering
  where
-  columnOrdering :: (ColumnName, OrderByDirection) -> RawSql.RawSql
+  columnOrdering :: (Qualified ColumnName, OrderByDirection) -> RawSql.RawSql
   columnOrdering (columnName, orderByDirection) =
     RawSql.toRawSql columnName <> RawSql.space <> RawSql.toRawSql orderByDirection
 
@@ -96,7 +96,7 @@ orderByColumnsExpr =
 
 @since 1.0.0.0
 -}
-orderByColumnName :: ColumnName -> OrderByDirection -> OrderByExpr
+orderByColumnName :: Qualified ColumnName -> OrderByDirection -> OrderByExpr
 orderByColumnName =
   curry (orderByColumnsExpr . pure)
 

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/Query.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/Query.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -26,7 +26,7 @@ import Data.Maybe (catMaybes, fromMaybe)
 
 import Orville.PostgreSQL.Expr.GroupBy (GroupByClause)
 import Orville.PostgreSQL.Expr.LimitExpr (LimitExpr)
-import Orville.PostgreSQL.Expr.Name (ColumnName)
+import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified)
 import Orville.PostgreSQL.Expr.OffsetExpr (OffsetExpr)
 import Orville.PostgreSQL.Expr.OrderBy (OrderByClause)
 import Orville.PostgreSQL.Expr.Select (SelectClause)
@@ -110,7 +110,7 @@ selectStar =
 
   @since 1.0.0.0
 -}
-selectColumns :: [ColumnName] -> SelectList
+selectColumns :: [Qualified ColumnName] -> SelectList
 selectColumns =
   selectDerivedColumns . map (deriveColumn . columnReference)
 
@@ -156,7 +156,7 @@ deriveColumn =
 
 @since 1.0.0.0
 -}
-deriveColumnAs :: ValueExpression -> ColumnName -> DerivedColumn
+deriveColumnAs :: ValueExpression -> Qualified ColumnName -> DerivedColumn
 deriveColumnAs valueExpr asColumn =
   DerivedColumn
     ( RawSql.toRawSql valueExpr

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/TableDefinition.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/TableDefinition.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -121,7 +121,7 @@ newtype PrimaryKeyExpr
 
   @since 1.0.0.0
 -}
-primaryKeyExpr :: NonEmpty ColumnName -> PrimaryKeyExpr
+primaryKeyExpr :: NonEmpty (Qualified ColumnName) -> PrimaryKeyExpr
 primaryKeyExpr columnNames =
   PrimaryKeyExpr $
     mconcat
@@ -235,7 +235,7 @@ dropConstraint constraintName =
 -}
 alterColumnType ::
   -- | The name of the column whose type will be altered.
-  ColumnName ->
+  Qualified ColumnName ->
   -- | The new type to use for the column.
   DataType ->
   -- | An optional 'UsingClause' to indicate to the database how data from the
@@ -274,7 +274,7 @@ newtype UsingClause
 
   @since 1.0.0.0
 -}
-usingCast :: ColumnName -> DataType -> UsingClause
+usingCast :: Qualified ColumnName -> DataType -> UsingClause
 usingCast columnName dataType =
   UsingClause $
     RawSql.fromString "USING "
@@ -288,7 +288,7 @@ usingCast columnName dataType =
 
   @since 1.0.0.0
 -}
-alterColumnNullability :: ColumnName -> AlterNotNull -> AlterTableAction
+alterColumnNullability :: Qualified ColumnName -> AlterNotNull -> AlterTableAction
 alterColumnNullability columnName alterNotNull =
   AlterTableAction $
     RawSql.intercalate
@@ -337,7 +337,7 @@ dropNotNull =
 
   @since 1.0.0.0
 -}
-alterColumnDropDefault :: ColumnName -> AlterTableAction
+alterColumnDropDefault :: Qualified ColumnName -> AlterTableAction
 alterColumnDropDefault columnName =
   AlterTableAction $
     RawSql.intercalate
@@ -355,7 +355,7 @@ alterColumnDropDefault columnName =
 -}
 alterColumnSetDefault ::
   RawSql.SqlExpression valueExpression =>
-  ColumnName ->
+  Qualified ColumnName ->
   valueExpression ->
   AlterTableAction
 alterColumnSetDefault columnName defaultValue =

diff --git a/orville-postgresql/src/Orville/PostgreSQL/Expr/Update.hs b/orville-postgresql/src/Orville/PostgreSQL/Expr/Update.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 {- |
-Copyright : Flipstone Technology Partners 2023
+Copyright : Flipstone Technology Partners 2023-2024
 License   : MIT
 Stability : Stable
 
@@ -116,7 +116,7 @@ newtype SetClause
 
   @since 1.0.0.0
 -}
-setColumn :: ColumnName -> SqlValue.SqlValue -> SetClause
+setColumn :: Qualified ColumnName -> SqlValue.SqlValue -> SetClause
 setColumn columnName value =
   SetClause $
     RawSql.toRawSql columnName