diff --git a/squeal-postgresql/squeal-postgresql.cabal b/squeal-postgresql/squeal-postgresql.cabal index bf37cee..1794c50 100644 --- a/squeal-postgresql/squeal-postgresql.cabal +++ b/squeal-postgresql/squeal-postgresql.cabal @@ -28,7 +28,6 @@ library Squeal.PostgreSQL.Definition.Function Squeal.PostgreSQL.Definition.Index Squeal.PostgreSQL.Definition.Table - Squeal.PostgreSQL.Definition.Table.Column Squeal.PostgreSQL.Definition.Table.Constraint Squeal.PostgreSQL.Definition.Type Squeal.PostgreSQL.Definition.Schema diff --git a/squeal-postgresql/src/Squeal/PostgreSQL.hs b/squeal-postgresql/src/Squeal/PostgreSQL.hs index f2226d8..5324ffd 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL.hs @@ -199,7 +199,6 @@ import Squeal.PostgreSQL.Definition.Function as X import Squeal.PostgreSQL.Definition.Index as X import Squeal.PostgreSQL.Definition.Schema as X import Squeal.PostgreSQL.Definition.Table as X -import Squeal.PostgreSQL.Definition.Table.Column as X import Squeal.PostgreSQL.Definition.Table.Constraint as X import Squeal.PostgreSQL.Definition.Type as X import Squeal.PostgreSQL.Definition.View as X diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs index 5da283a..fc14768 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs @@ -35,8 +35,6 @@ module Squeal.PostgreSQL.Definition Definition (..) , (>>>) , manipDefinition - , PGNullityTyped (..) - , hask ) where import Control.Category @@ -47,10 +45,7 @@ import Prelude hiding ((.), id) import qualified GHC.Generics as GHC -import Squeal.PostgreSQL.Definition.Table.Column -import Squeal.PostgreSQL.Expression.Type import Squeal.PostgreSQL.Manipulation -import Squeal.PostgreSQL.PG import Squeal.PostgreSQL.Render import Squeal.PostgreSQL.Schema @@ -85,24 +80,3 @@ manipDefinition -- ^ no input or output -> Definition schemas schemas manipDefinition = UnsafeDefinition . (<> ";") . renderSQL - --- | Like @PGTyped@ but also accounts for nullity. -class PGNullityTyped schemas (nullty :: NullityType) where - pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty) - -instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where - pgNullityType = nullable (pgtype @_ @('Null ty)) - -instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where - pgNullityType = notNullable (pgtype @_ @('NotNull ty)) - --- | Allow you to specify pg column types in relation to haskell types. --- >>> printSQL $ hask @(Maybe String) --- text NULL --- --- >>> printSQL $ hask @Double --- float8 NOT NULL -hask - :: forall h schemas. PGNullityTyped schemas (NullPG h) - => ColumnTypeExpression schemas ('NoDef :=> NullPG h) -hask = pgNullityType diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs index b01e300..57d0c12 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hs @@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC import Squeal.PostgreSQL.Alias import Squeal.PostgreSQL.Definition -import Squeal.PostgreSQL.Definition.Table.Column import Squeal.PostgreSQL.Definition.Table.Constraint import Squeal.PostgreSQL.Expression +import Squeal.PostgreSQL.Expression.Type import Squeal.PostgreSQL.List import Squeal.PostgreSQL.Render import Squeal.PostgreSQL.Schema diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs deleted file mode 100644 index d2fd2d4..0000000 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-| -Module: Squeal.PostgreSQL.Definition.Table.Column -Description: Column type expressions -Copyright: (c) Eitan Chatav, 2017 -Maintainer: eitan@morphism.tech -Stability: experimental - -Column type expressions. --} - -{-# LANGUAGE - AllowAmbiguousTypes - , ConstraintKinds - , DeriveAnyClass - , DeriveGeneric - , DerivingStrategies - , FlexibleContexts - , FlexibleInstances - , GADTs - , LambdaCase - , MultiParamTypeClasses - , OverloadedLabels - , OverloadedStrings - , RankNTypes - , ScopedTypeVariables - , TypeApplications - , TypeInType - , TypeOperators - , UndecidableSuperClasses -#-} - -module Squeal.PostgreSQL.Definition.Table.Column - ( ColumnTypeExpression (..) - , nullable - , notNullable - , default_ - , serial2 - , smallserial - , serial4 - , serial - , serial8 - , bigserial - ) where - -import Control.DeepSeq -import Data.ByteString - -import qualified GHC.Generics as GHC - -import Squeal.PostgreSQL.Alias -import Squeal.PostgreSQL.Expression -import Squeal.PostgreSQL.Expression.Type -import Squeal.PostgreSQL.Render -import Squeal.PostgreSQL.Schema - --- $setup --- >>> import Squeal.PostgreSQL - --- | `ColumnTypeExpression`s are used in `createTable` commands. -newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType) - = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString } - deriving (GHC.Generic,Show,Eq,Ord,NFData) -instance RenderSQL (ColumnTypeExpression schemas ty) where - renderSQL = renderColumnTypeExpression - --- | used in `createTable` commands as a column constraint to note that --- @NULL@ may be present in a column -nullable - :: TypeExpression schemas (nullity ty) - -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty) -nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL" - --- | used in `createTable` commands as a column constraint to ensure --- @NULL@ is not present in a column -notNullable - :: TypeExpression schemas (nullity ty) - -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty) -notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL" - --- | used in `createTable` commands as a column constraint to give a default -default_ - :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty - -> ColumnTypeExpression schemas ('NoDef :=> ty) - -> ColumnTypeExpression schemas ('Def :=> ty) -default_ x ty = UnsafeColumnTypeExpression $ - renderSQL ty <+> "DEFAULT" <+> renderExpression x - --- | not a true type, but merely a notational convenience for creating --- unique identifier columns with type `PGint2` -serial2, smallserial - :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2) -serial2 = UnsafeColumnTypeExpression "serial2" -smallserial = UnsafeColumnTypeExpression "smallserial" --- | not a true type, but merely a notational convenience for creating --- unique identifier columns with type `PGint4` -serial4, serial - :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4) -serial4 = UnsafeColumnTypeExpression "serial4" -serial = UnsafeColumnTypeExpression "serial" --- | not a true type, but merely a notational convenience for creating --- unique identifier columns with type `PGint8` -serial8, bigserial - :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8) -serial8 = UnsafeColumnTypeExpression "serial8" -bigserial = UnsafeColumnTypeExpression "bigserial" diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs index ccc4f94..ab51468 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs @@ -23,15 +23,16 @@ Type expressions. , ScopedTypeVariables , TypeApplications , TypeOperators + , UndecidableInstances #-} module Squeal.PostgreSQL.Expression.Type - ( TypeExpression (..) - , cast + ( -- * type casting + cast , astype , inferredtype - , PGTyped (..) - , FieldTyped (..) + -- * type expressions + , TypeExpression (..) , typedef , typetable , typeview @@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type , tsrange , tstzrange , daterange + -- * column type definitions + , ColumnTypeExpression (..) + , nullable + , notNullable + , default_ + , serial2 + , smallserial + , serial4 + , serial + , serial8 + , bigserial + , hask + -- * type inference + , PGTyped (..) + , PGNullityTyped (..) + , FieldTyped (..) ) where import Control.DeepSeq @@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP import Squeal.PostgreSQL.Alias import Squeal.PostgreSQL.Expression +import Squeal.PostgreSQL.PG import Squeal.PostgreSQL.Render import Squeal.PostgreSQL.Schema @@ -132,6 +150,7 @@ astype = cast inferredtype :: PGTyped schemas ty => Expression outer common grp schemas params from ty + -- ^ value -> Expression outer common grp schemas params from ty inferredtype = astype pgtype @@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where typedef :: (Has sch schemas schema, Has td schema ('Typedef ty)) => QualifiedAlias sch td + -- ^ type alias -> TypeExpression schemas (null ty) typedef = UnsafeTypeExpression . renderSQL @@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL typetable :: (Has sch schemas schema, Has tab schema ('Table table)) => QualifiedAlias sch tab + -- ^ table alias -> TypeExpression schemas (null ('PGcomposite (TableToRow table))) typetable = UnsafeTypeExpression . renderSQL @@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL typeview :: (Has sch schemas schema, Has vw schema ('View view)) => QualifiedAlias sch vw + -- ^ view alias -> TypeExpression schemas (null ('PGcomposite view)) typeview = UnsafeTypeExpression . renderSQL @@ -353,3 +375,72 @@ class FieldTyped schemas ty where instance (KnownSymbol alias, PGTyped schemas ty) => FieldTyped schemas (alias ::: ty) where fieldtype = pgtype `As` Alias + +-- | `ColumnTypeExpression`s are used in `createTable` commands. +newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType) + = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString } + deriving (GHC.Generic,Show,Eq,Ord,NFData) +instance RenderSQL (ColumnTypeExpression schemas ty) where + renderSQL = renderColumnTypeExpression + +-- | used in `createTable` commands as a column constraint to note that +-- @NULL@ may be present in a column +nullable + :: TypeExpression schemas (nullity ty) + -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty) +nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL" + +-- | used in `createTable` commands as a column constraint to ensure +-- @NULL@ is not present in a column +notNullable + :: TypeExpression schemas (nullity ty) + -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty) +notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL" + +-- | used in `createTable` commands as a column constraint to give a default +default_ + :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty + -> ColumnTypeExpression schemas ('NoDef :=> ty) + -> ColumnTypeExpression schemas ('Def :=> ty) +default_ x ty = UnsafeColumnTypeExpression $ + renderSQL ty <+> "DEFAULT" <+> renderExpression x + +-- | not a true type, but merely a notational convenience for creating +-- unique identifier columns with type `PGint2` +serial2, smallserial + :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2) +serial2 = UnsafeColumnTypeExpression "serial2" +smallserial = UnsafeColumnTypeExpression "smallserial" +-- | not a true type, but merely a notational convenience for creating +-- unique identifier columns with type `PGint4` +serial4, serial + :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4) +serial4 = UnsafeColumnTypeExpression "serial4" +serial = UnsafeColumnTypeExpression "serial" +-- | not a true type, but merely a notational convenience for creating +-- unique identifier columns with type `PGint8` +serial8, bigserial + :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8) +serial8 = UnsafeColumnTypeExpression "serial8" +bigserial = UnsafeColumnTypeExpression "bigserial" + +-- | Like @PGTyped@ but also accounts for nullity. +class PGNullityTyped schemas (nullty :: NullityType) where + pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty) + +instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where + pgNullityType = nullable (pgtype @_ @('Null ty)) + +instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where + pgNullityType = notNullable (pgtype @_ @('NotNull ty)) + +-- | Allow you to specify pg column types in relation to haskell types. +-- >>> printSQL $ hask @(Maybe String) +-- text NULL +-- +-- >>> printSQL $ hask @Double +-- float8 NOT NULL +hask + :: forall hask schemas. PGNullityTyped schemas (NullPG hask) + => ColumnTypeExpression schemas ('NoDef :=> NullPG hask) +hask = pgNullityType diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs index 2cc2be1..8945425 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs @@ -168,7 +168,6 @@ import Squeal.PostgreSQL.Alias import Squeal.PostgreSQL.Binary import Squeal.PostgreSQL.Definition import Squeal.PostgreSQL.Definition.Table -import Squeal.PostgreSQL.Definition.Table.Column import Squeal.PostgreSQL.Definition.Table.Constraint import Squeal.PostgreSQL.Expression.Comparison import Squeal.PostgreSQL.Expression.Parameter