mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-12 00:07:34 +03:00
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.
This commit is contained in:
parent
8cec776fa6
commit
c778ac1763
37
changelog.d/20230711_125727_shane.obrien_QualifiedName.md
Normal file
37
changelog.d/20230711_125727_shane.obrien_QualifiedName.md
Normal file
@ -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.
|
||||
|
||||
-->
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -3,6 +3,7 @@
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language FlexibleInstances #-}
|
||||
{-# language MultiParamTypeClasses #-}
|
||||
{-# language OverloadedStrings #-}
|
||||
{-# language ScopedTypeVariables #-}
|
||||
{-# language StandaloneKindSignatures #-}
|
||||
{-# language TypeApplications #-}
|
||||
|
@ -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
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# language FlexibleContexts #-}
|
||||
{-# language OverloadedStrings #-}
|
||||
{-# language TypeFamilies #-}
|
||||
|
||||
{-# options_ghc -fno-warn-redundant-constraints #-}
|
||||
|
@ -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)))
|
||||
]
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# language DataKinds #-}
|
||||
{-# language OverloadedStrings #-}
|
||||
|
||||
module Rel8.Expr.Text
|
||||
(
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# language OverloadedStrings #-}
|
||||
|
||||
module Rel8.Expr.Time
|
||||
( -- * Working with @Day@
|
||||
today
|
||||
|
49
src/Rel8/Schema/QualifiedName.hs
Normal file
49
src/Rel8/Schema/QualifiedName.hs
Normal file
@ -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
|
||||
}
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
@ -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 = ()}
|
||||
|
@ -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)
|
||||
|
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user