mirror of
https://github.com/ilyakooo0/squeal.git
synced 2024-10-26 06:59:14 +03:00
move type things around
This commit is contained in:
parent
b63086cdbb
commit
4b59f5288a
@ -28,7 +28,6 @@ library
|
|||||||
Squeal.PostgreSQL.Definition.Function
|
Squeal.PostgreSQL.Definition.Function
|
||||||
Squeal.PostgreSQL.Definition.Index
|
Squeal.PostgreSQL.Definition.Index
|
||||||
Squeal.PostgreSQL.Definition.Table
|
Squeal.PostgreSQL.Definition.Table
|
||||||
Squeal.PostgreSQL.Definition.Table.Column
|
|
||||||
Squeal.PostgreSQL.Definition.Table.Constraint
|
Squeal.PostgreSQL.Definition.Table.Constraint
|
||||||
Squeal.PostgreSQL.Definition.Type
|
Squeal.PostgreSQL.Definition.Type
|
||||||
Squeal.PostgreSQL.Definition.Schema
|
Squeal.PostgreSQL.Definition.Schema
|
||||||
|
@ -199,7 +199,6 @@ import Squeal.PostgreSQL.Definition.Function as X
|
|||||||
import Squeal.PostgreSQL.Definition.Index as X
|
import Squeal.PostgreSQL.Definition.Index as X
|
||||||
import Squeal.PostgreSQL.Definition.Schema as X
|
import Squeal.PostgreSQL.Definition.Schema as X
|
||||||
import Squeal.PostgreSQL.Definition.Table 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.Table.Constraint as X
|
||||||
import Squeal.PostgreSQL.Definition.Type as X
|
import Squeal.PostgreSQL.Definition.Type as X
|
||||||
import Squeal.PostgreSQL.Definition.View as X
|
import Squeal.PostgreSQL.Definition.View as X
|
||||||
|
@ -35,8 +35,6 @@ module Squeal.PostgreSQL.Definition
|
|||||||
Definition (..)
|
Definition (..)
|
||||||
, (>>>)
|
, (>>>)
|
||||||
, manipDefinition
|
, manipDefinition
|
||||||
, PGNullityTyped (..)
|
|
||||||
, hask
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Category
|
import Control.Category
|
||||||
@ -47,10 +45,7 @@ import Prelude hiding ((.), id)
|
|||||||
|
|
||||||
import qualified GHC.Generics as GHC
|
import qualified GHC.Generics as GHC
|
||||||
|
|
||||||
import Squeal.PostgreSQL.Definition.Table.Column
|
|
||||||
import Squeal.PostgreSQL.Expression.Type
|
|
||||||
import Squeal.PostgreSQL.Manipulation
|
import Squeal.PostgreSQL.Manipulation
|
||||||
import Squeal.PostgreSQL.PG
|
|
||||||
import Squeal.PostgreSQL.Render
|
import Squeal.PostgreSQL.Render
|
||||||
import Squeal.PostgreSQL.Schema
|
import Squeal.PostgreSQL.Schema
|
||||||
|
|
||||||
@ -85,24 +80,3 @@ manipDefinition
|
|||||||
-- ^ no input or output
|
-- ^ no input or output
|
||||||
-> Definition schemas schemas
|
-> Definition schemas schemas
|
||||||
manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
|
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
|
|
||||||
|
@ -62,9 +62,9 @@ import qualified GHC.Generics as GHC
|
|||||||
|
|
||||||
import Squeal.PostgreSQL.Alias
|
import Squeal.PostgreSQL.Alias
|
||||||
import Squeal.PostgreSQL.Definition
|
import Squeal.PostgreSQL.Definition
|
||||||
import Squeal.PostgreSQL.Definition.Table.Column
|
|
||||||
import Squeal.PostgreSQL.Definition.Table.Constraint
|
import Squeal.PostgreSQL.Definition.Table.Constraint
|
||||||
import Squeal.PostgreSQL.Expression
|
import Squeal.PostgreSQL.Expression
|
||||||
|
import Squeal.PostgreSQL.Expression.Type
|
||||||
import Squeal.PostgreSQL.List
|
import Squeal.PostgreSQL.List
|
||||||
import Squeal.PostgreSQL.Render
|
import Squeal.PostgreSQL.Render
|
||||||
import Squeal.PostgreSQL.Schema
|
import Squeal.PostgreSQL.Schema
|
||||||
|
@ -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"
|
|
@ -23,15 +23,16 @@ Type expressions.
|
|||||||
, ScopedTypeVariables
|
, ScopedTypeVariables
|
||||||
, TypeApplications
|
, TypeApplications
|
||||||
, TypeOperators
|
, TypeOperators
|
||||||
|
, UndecidableInstances
|
||||||
#-}
|
#-}
|
||||||
|
|
||||||
module Squeal.PostgreSQL.Expression.Type
|
module Squeal.PostgreSQL.Expression.Type
|
||||||
( TypeExpression (..)
|
( -- * type casting
|
||||||
, cast
|
cast
|
||||||
, astype
|
, astype
|
||||||
, inferredtype
|
, inferredtype
|
||||||
, PGTyped (..)
|
-- * type expressions
|
||||||
, FieldTyped (..)
|
, TypeExpression (..)
|
||||||
, typedef
|
, typedef
|
||||||
, typetable
|
, typetable
|
||||||
, typeview
|
, typeview
|
||||||
@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type
|
|||||||
, tsrange
|
, tsrange
|
||||||
, tstzrange
|
, tstzrange
|
||||||
, daterange
|
, daterange
|
||||||
|
-- * column type definitions
|
||||||
|
, ColumnTypeExpression (..)
|
||||||
|
, nullable
|
||||||
|
, notNullable
|
||||||
|
, default_
|
||||||
|
, serial2
|
||||||
|
, smallserial
|
||||||
|
, serial4
|
||||||
|
, serial
|
||||||
|
, serial8
|
||||||
|
, bigserial
|
||||||
|
, hask
|
||||||
|
-- * type inference
|
||||||
|
, PGTyped (..)
|
||||||
|
, PGNullityTyped (..)
|
||||||
|
, FieldTyped (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP
|
|||||||
|
|
||||||
import Squeal.PostgreSQL.Alias
|
import Squeal.PostgreSQL.Alias
|
||||||
import Squeal.PostgreSQL.Expression
|
import Squeal.PostgreSQL.Expression
|
||||||
|
import Squeal.PostgreSQL.PG
|
||||||
import Squeal.PostgreSQL.Render
|
import Squeal.PostgreSQL.Render
|
||||||
import Squeal.PostgreSQL.Schema
|
import Squeal.PostgreSQL.Schema
|
||||||
|
|
||||||
@ -132,6 +150,7 @@ astype = cast
|
|||||||
inferredtype
|
inferredtype
|
||||||
:: PGTyped schemas ty
|
:: PGTyped schemas ty
|
||||||
=> Expression outer common grp schemas params from ty
|
=> Expression outer common grp schemas params from ty
|
||||||
|
-- ^ value
|
||||||
-> Expression outer common grp schemas params from ty
|
-> Expression outer common grp schemas params from ty
|
||||||
inferredtype = astype pgtype
|
inferredtype = astype pgtype
|
||||||
|
|
||||||
@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where
|
|||||||
typedef
|
typedef
|
||||||
:: (Has sch schemas schema, Has td schema ('Typedef ty))
|
:: (Has sch schemas schema, Has td schema ('Typedef ty))
|
||||||
=> QualifiedAlias sch td
|
=> QualifiedAlias sch td
|
||||||
|
-- ^ type alias
|
||||||
-> TypeExpression schemas (null ty)
|
-> TypeExpression schemas (null ty)
|
||||||
typedef = UnsafeTypeExpression . renderSQL
|
typedef = UnsafeTypeExpression . renderSQL
|
||||||
|
|
||||||
@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL
|
|||||||
typetable
|
typetable
|
||||||
:: (Has sch schemas schema, Has tab schema ('Table table))
|
:: (Has sch schemas schema, Has tab schema ('Table table))
|
||||||
=> QualifiedAlias sch tab
|
=> QualifiedAlias sch tab
|
||||||
|
-- ^ table alias
|
||||||
-> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
|
-> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
|
||||||
typetable = UnsafeTypeExpression . renderSQL
|
typetable = UnsafeTypeExpression . renderSQL
|
||||||
|
|
||||||
@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL
|
|||||||
typeview
|
typeview
|
||||||
:: (Has sch schemas schema, Has vw schema ('View view))
|
:: (Has sch schemas schema, Has vw schema ('View view))
|
||||||
=> QualifiedAlias sch vw
|
=> QualifiedAlias sch vw
|
||||||
|
-- ^ view alias
|
||||||
-> TypeExpression schemas (null ('PGcomposite view))
|
-> TypeExpression schemas (null ('PGcomposite view))
|
||||||
typeview = UnsafeTypeExpression . renderSQL
|
typeview = UnsafeTypeExpression . renderSQL
|
||||||
|
|
||||||
@ -353,3 +375,72 @@ class FieldTyped schemas ty where
|
|||||||
instance (KnownSymbol alias, PGTyped schemas ty)
|
instance (KnownSymbol alias, PGTyped schemas ty)
|
||||||
=> FieldTyped schemas (alias ::: ty) where
|
=> FieldTyped schemas (alias ::: ty) where
|
||||||
fieldtype = pgtype `As` Alias
|
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
|
||||||
|
@ -168,7 +168,6 @@ import Squeal.PostgreSQL.Alias
|
|||||||
import Squeal.PostgreSQL.Binary
|
import Squeal.PostgreSQL.Binary
|
||||||
import Squeal.PostgreSQL.Definition
|
import Squeal.PostgreSQL.Definition
|
||||||
import Squeal.PostgreSQL.Definition.Table
|
import Squeal.PostgreSQL.Definition.Table
|
||||||
import Squeal.PostgreSQL.Definition.Table.Column
|
|
||||||
import Squeal.PostgreSQL.Definition.Table.Constraint
|
import Squeal.PostgreSQL.Definition.Table.Constraint
|
||||||
import Squeal.PostgreSQL.Expression.Comparison
|
import Squeal.PostgreSQL.Expression.Comparison
|
||||||
import Squeal.PostgreSQL.Expression.Parameter
|
import Squeal.PostgreSQL.Expression.Parameter
|
||||||
|
Loading…
Reference in New Issue
Block a user