move type things around

This commit is contained in:
Eitan Chatav 2019-10-30 12:28:54 -07:00
parent b63086cdbb
commit 4b59f5288a
7 changed files with 96 additions and 139 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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