Introduce QualifiedName (fixes #228) (#257)

This adds a new type `QualifiedName` for named PostgreSQL objects (tables, views, functions and sequences) that can optionally be qualified by a schema. Previously only `TableSchema` could be qualified in this way.

`QualifiedName` has an `IsString` instance so the common case (where the schema is `Nothing`) doesn't have to care about schemas (if `OverloadedStrings` is enabled).

This also refactors `TableSchema` to use `QualifiedName` for its `name` field and drops its `schema` field.

Thanks to @elldritch for the bug report and the inspiration.

changelog.d/20230711_125727_shane.obrien_QualifiedName.md

@@ -0,0 +1,37 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Removed
+
+- A bullet item for the Removed category.
+
+-->
+### Added
+
+- Added the `QualifiedName` type for named PostgreSQL objects (tables, views, functions, sequences, etc.) that can optionally be qualified by a schema, including an `IsString` instance.
+
+### Changed
+
+- The `schema` field from `TableSchema` has been removed and the name field changed from `String` to `QualifiedName`.
+- `nextval` and `function` now take a `QualifiedName` instead of a `String`.
+
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+### Fixed
+
+- Fixes [#228](https://github.com/circuithub/rel8/issues/228) where it was impossible to call `nextval` with a qualified sequence name.
+
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

rel8.cabal

@@ -150,6 +150,7 @@ library
     Rel8.Schema.Kind
     Rel8.Schema.Name
     Rel8.Schema.Null
+    Rel8.Schema.QualifiedName
     Rel8.Schema.Result
     Rel8.Schema.Spec
     Rel8.Schema.Table

src/Rel8.hs

@@ -155,6 +155,7 @@ module Rel8
 
     -- ** Table schemas
   , TableSchema(..)
+  , QualifiedName(..)
   , Name
   , namesFromLabels
   , namesFromLabelsWith
@@ -426,6 +427,7 @@ import Rel8.Schema.Field
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )
+import Rel8.Schema.QualifiedName
 import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Table
 import Rel8.Statement

src/Rel8/Expr.hs

@@ -3,6 +3,7 @@
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language MultiParamTypeClasses #-}
+{-# language OverloadedStrings #-}
 {-# language ScopedTypeVariables #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeApplications #-}

src/Rel8/Expr/Function.hs

@@ -27,6 +27,7 @@ import Rel8.Expr.Opaleye
   , fromPrimExpr, toPrimExpr, zipPrimExprsWith
   )
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName)
 import Rel8.Type ( DBType )
 
 
@@ -48,13 +49,15 @@ instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where
 
 -- | Construct an n-ary function that produces an 'Expr' that when called runs
 -- a SQL function.
-function :: Function args result => String -> args -> result
-function = applyArgument . Opaleye.FunExpr
+function :: Function args result => QualifiedName -> args -> result
+function = applyArgument . Opaleye.FunExpr . show . ppQualifiedName
 
 
 -- | Construct a function call for functions with no arguments.
-nullaryFunction :: Sql DBType a => String -> Expr a
-nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])
+nullaryFunction :: Sql DBType a => QualifiedName -> Expr a
+nullaryFunction qualified = castExpr $ Expr (Opaleye.FunExpr name [])
+  where
+    name = show $ ppQualifiedName qualified
 
 
 -- | Construct an expression by applying an infix binary operator to two

src/Rel8/Expr/Num.hs

@@ -1,4 +1,5 @@
 {-# language FlexibleContexts #-}
+{-# language OverloadedStrings #-}
 {-# language TypeFamilies #-}
 
 {-# options_ghc -fno-warn-redundant-constraints #-}

src/Rel8/Expr/Sequence.hs

@@ -7,16 +7,19 @@ where
 import Data.Int ( Int64 )
 import Prelude
 
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
+
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Expr.Function ( function )
-import Rel8.Expr.Serialize ( litExpr )
-import Rel8.Expr.Text ( quoteIdent )
-
--- text
-import Data.Text ( pack )
+import Rel8.Expr.Opaleye (fromPrimExpr)
+import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName)
 
 
 -- | See https://www.postgresql.org/docs/current/functions-sequence.html
-nextval :: String -> Expr Int64
-nextval = function "nextval" . quoteIdent . litExpr . pack
+nextval :: QualifiedName -> Expr Int64
+nextval name =
+  fromPrimExpr $
+    Opaleye.FunExpr "nextval"
+      [ Opaleye.ConstExpr (Opaleye.StringLit (show (ppQualifiedName name)))
+      ]

src/Rel8/Expr/Text.hs

@@ -1,4 +1,5 @@
 {-# language DataKinds #-}
+{-# language OverloadedStrings #-}
 
 module Rel8.Expr.Text
   (

src/Rel8/Expr/Time.hs

@@ -1,3 +1,5 @@
+{-# language OverloadedStrings #-}
+
 module Rel8.Expr.Time
   ( -- * Working with @Day@
     today

src/Rel8/Schema/QualifiedName.hs

@@ -0,0 +1,49 @@
+{-# language DerivingStrategies #-}
+{-# language DuplicateRecordFields #-}
+{-# language RecordWildCards #-}
+{-# language StandaloneKindSignatures #-}
+{-# language StrictData #-}
+
+module Rel8.Schema.QualifiedName
+  ( QualifiedName (..)
+  , ppQualifiedName
+  )
+where
+
+-- base
+import Data.Kind (Type)
+import Data.String (IsString, fromString)
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
+import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
+
+-- pretty
+import Text.PrettyPrint (Doc)
+
+
+-- | A name of an object (such as a table, view, function or sequence)
+-- qualified by an optional schema. In the absence of an explicit schema,
+-- the connection's @search_path@ will be used implicitly.
+type QualifiedName :: Type
+data QualifiedName = QualifiedName
+  { name :: String
+    -- ^ The name of the object.
+  , schema :: Maybe String
+    -- ^ The schema that this object belongs to. If 'Nothing', whatever is on
+    -- the connection's @search_path@ will be used.
+   }
+  deriving stock (Eq, Ord, Show)
+
+
+-- | Constructs 'QualifiedName's with 'schema' set to 'Nothing'.
+instance IsString QualifiedName where
+  fromString name = QualifiedName {schema = Nothing, ..}
+
+
+ppQualifiedName :: QualifiedName -> Doc
+ppQualifiedName QualifiedName {..} = Opaleye.ppTable Opaleye.SqlTable
+  { sqlTableSchemaName = schema
+  , sqlTableName = name
+  }

src/Rel8/Schema/Table.hs

@@ -1,8 +1,9 @@
 {-# language DeriveFunctor #-}
 {-# language DerivingStrategies #-}
-{-# language DisambiguateRecordFields #-}
+{-# language DuplicateRecordFields #-}
 {-# language NamedFieldPuns #-}
 {-# language StandaloneKindSignatures #-}
+{-# language StrictData #-}
 
 module Rel8.Schema.Table
   ( TableSchema(..)
@@ -14,13 +15,12 @@ where
 import Data.Kind ( Type )
 import Prelude
 
--- opaleye
-import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
-import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
-
 -- pretty
 import Text.PrettyPrint ( Doc )
 
+-- rel8
+import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName)
+
 
 -- | The schema for a table. This is used to specify the name and schema that a
 -- table belongs to (the @FROM@ part of a SQL query), along with the schema of
@@ -30,20 +30,14 @@ import Text.PrettyPrint ( Doc )
 -- @TableSchema@ in order to interact with the table via Rel8.
 type TableSchema :: Type -> Type
 data TableSchema names = TableSchema
-  { name :: String
+  { name :: QualifiedName
     -- ^ The name of the table.
-  , schema :: Maybe String
-    -- ^ The schema that this table belongs to. If 'Nothing', whatever is on
-    -- the connection's @search_path@ will be used.
   , columns :: names
-    -- ^ The columns of the table. Typically you would use a a higher-kinded
-    -- data type here, parameterized by the 'Rel8.ColumnSchema.ColumnSchema' functor.
+    -- ^ The columns of the table. Typically you would use a 'Rel8.Rel8able'
+    -- data type here, parameterized by the 'Rel8.Name' context.
   }
   deriving stock Functor
 
 
 ppTable :: TableSchema a -> Doc
-ppTable TableSchema {name, schema} = Opaleye.ppTable Opaleye.SqlTable
-  { sqlTableSchemaName = schema
-  , sqlTableName = name
-  }
+ppTable TableSchema {name} = ppQualifiedName name

src/Rel8/Statement.hs

@@ -26,6 +26,7 @@ import Data.Int (Int64)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty, intersperse)
 import Data.Monoid (Endo (Endo))
+import Data.String (fromString)
 import Prelude
 
 -- hasql
@@ -203,8 +204,7 @@ statementReturning pp = Statement $ do
       query =
         fromCols <$> each
           TableSchema
-            { name = relation
-            , schema = Nothing
+            { name = fromString relation
             , columns = names
             }
       returning = Returning (countRows query)

src/Rel8/Statement/OnConflict.hs

@@ -3,6 +3,7 @@
 {-# language GADTs #-}
 {-# language LambdaCase #-}
 {-# language NamedFieldPuns #-}
+{-# language OverloadedStrings #-}
 {-# language RecordWildCards #-}
 {-# language StandaloneKindSignatures #-}
 {-# language StrictData #-}
@@ -94,8 +95,7 @@ ppUpsert schema@TableSchema {columns} Upsert {..} =
   ppWhere schema (updateWhere excluded)
   where
     excluded = attributes TableSchema
-      { schema = Nothing
-      , name = "excluded"
+      { name = "excluded"
       , columns
       }
 

src/Rel8/Statement/Using.hs

@@ -1,3 +1,5 @@
+{-# language OverloadedStrings #-}
+
 module Rel8.Statement.Using
   ( ppFrom
   , ppUsing
@@ -40,4 +42,4 @@ ppJoin clause join = do
       Optimized doc -> Just $ text clause <+> parens doc <+> ppTable alias
     pure (doc, a)
   where
-    alias = TableSchema {name = "T1", schema = Nothing, columns = ()}
+    alias = TableSchema {name = "T1", columns = ()}

src/Rel8/Table/Opaleye.hs

@@ -49,6 +49,7 @@ import Rel8.Expr.Opaleye
 import Rel8.Schema.HTable ( htabulateA, hfield, hspecs, htabulate,
                             htraverseP, htraversePWithField )
 import Rel8.Schema.Name ( Name( Name ), Selects, ppColumn )
+import Rel8.Schema.QualifiedName (QualifiedName (QualifiedName))
 import Rel8.Schema.Spec ( Spec(..) )
 import Rel8.Schema.Table ( TableSchema(..), ppTable )
 import Rel8.Table ( Table, fromColumns, toColumns )
@@ -100,7 +101,7 @@ ifPP = fromOpaleyespec Opaleye.ifPPField
 
 
 table :: Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs
-table (TableSchema name schema columns) =
+table (TableSchema (QualifiedName name schema) columns) =
   case schema of
     Nothing -> Opaleye.table name (tableFields columns)
     Just schemaName -> Opaleye.tableWithSchema schemaName name (tableFields columns)

tests/Main.hs

@@ -189,7 +189,6 @@ testTableSchema :: Rel8.TableSchema (TestTable Rel8.Name)
 testTableSchema =
   Rel8.TableSchema
     { name = "test_table"
-    , schema = Nothing
     , columns = TestTable
         { testTableColumn1 = "column1"
         , testTableColumn2 = "column2"
@@ -887,7 +886,6 @@ uniqueTableSchema :: Rel8.TableSchema (UniqueTable Rel8.Name)
 uniqueTableSchema =
   Rel8.TableSchema
     { name = "unique_table"
-    , schema = Nothing
     , columns = UniqueTable
         { uniqueTableKey = "key"
         , uniqueTableValue = "value"