| Copyright | (c) Eitan Chatav 2010 |
|---|---|
| Maintainer | eitan@morphism.tech |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Squeal.PostgreSQL.PG
Synopsis
- type family PG (hask :: Type) :: PGType
- type family NullPG (hask :: Type) :: NullityType where ...
- type family TuplePG (hask :: Type) :: [NullityType] where ...
- type family RowPG (hask :: Type) :: RowType where ...
- newtype Money = Money {}
- newtype Json hask = Json {
- getJson :: hask
- newtype Jsonb hask = Jsonb {
- getJsonb :: hask
- newtype Composite record = Composite {
- getComposite :: record
- newtype Enumerated enum = Enumerated {
- getEnumerated :: enum
- newtype VarArray arr = VarArray {
- getVarArray :: arr
- newtype FixArray arr = FixArray {
- getFixArray :: arr
- type family LabelsPG (hask :: Type) :: [ConstructorName] where ...
- type family DimPG (hask :: Type) :: [Nat] where ...
- type family FixPG (hask :: Type) :: NullityType where ...
- type family TupleOf (tuple :: [Type]) :: [NullityType] where ...
- type family TupleCodeOf (hask :: Type) (code :: [[Type]]) :: [Type] where ...
- type family RowOf (record :: [(Symbol, Type)]) :: RowType where ...
- type family ConstructorsOf (datatype :: DatatypeInfo) :: [ConstructorInfo] where ...
- type family ConstructorNameOf (constructor :: ConstructorInfo) :: ConstructorName where ...
- type family ConstructorNamesOf (constructors :: [ConstructorInfo]) :: [ConstructorName] where ...
PG embeddings
type family PG (hask :: Type) :: PGType Source #
The PG type family embeds a subset of Haskell types
as Postgres types. As an open type family, PG is extensible.
>>>:kind! PG LocalTimePG LocalTime :: PGType = 'PGtimestamp
>>>newtype MyDouble = My Double>>>:set -XTypeFamilies>>>type instance PG MyDouble = 'PGfloat8
Instances
type family NullPG (hask :: Type) :: NullityType where ... Source #
NullPG turns a Haskell type into a NullityType.
>>>:kind! NullPG DoubleNullPG Double :: NullityType = 'NotNull 'PGfloat8>>>:kind! NullPG (Maybe Double)NullPG (Maybe Double) :: NullityType = 'Null 'PGfloat8
type family TuplePG (hask :: Type) :: [NullityType] where ... Source #
TuplePG turns a Haskell tuple type (including record types) into
the corresponding list of NullityTypes.
>>>:kind! TuplePG (Double, Maybe Char)TuplePG (Double, Maybe Char) :: [NullityType] = '[ 'NotNull 'PGfloat8, 'Null ('PGchar 1)]
Equations
| TuplePG hask = TupleOf (TupleCodeOf hask (Code hask)) |
type family RowPG (hask :: Type) :: RowType where ... Source #
RowPG turns a Haskell Type into a RowType.
RowPG may be applied to normal Haskell record types provided they
have Generic and HasDatatypeInfo instances;
>>>data Person = Person { name :: Strict.Text, age :: Int32 } deriving GHC.Generic>>>instance SOP.Generic Person>>>instance SOP.HasDatatypeInfo Person>>>:kind! RowPG PersonRowPG Person :: [(Symbol, NullityType)] = '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]
Equations
| RowPG hask = RowOf (RecordCodeOf hask) |
Storage newtypes
The Money newtype stores a monetary value in terms
of the number of cents, i.e. $2,000.20 would be expressed as
Money { cents = 200020 }.
>>>import Control.Monad (void)>>>import Control.Monad.IO.Class (liftIO)>>>import Squeal.PostgreSQL>>>:{let roundTrip :: Query_ (Public '[]) (Only Money) (Only Money) roundTrip = values_ $ parameter @1 money `as` #fromOnly :}
>>>let input = Only (Money 20020)
>>>:{withConnection "host=localhost port=5432 dbname=exampledb" $ do result <- runQueryParams roundTrip input Just output <- firstRow result liftIO . print $ input == output :} True
The Json newtype is an indication that the Haskell
type it's applied to should be stored as a PGjson.
Instances
| FromJSON x => FromValue PGjson (Json x) Source # | |
| Eq hask => Eq (Json hask) Source # | |
| Ord hask => Ord (Json hask) Source # | |
| Read hask => Read (Json hask) Source # | |
| Show hask => Show (Json hask) Source # | |
| Generic (Json hask) Source # | |
| ToJSON hask => Literal (Json hask) Source # | |
| ToJSON x => ToParam (Json x) PGjson Source # | |
| type Rep (Json hask) Source # | |
Defined in Squeal.PostgreSQL.PG | |
| type PG (Json hask) Source # | |
Defined in Squeal.PostgreSQL.PG | |
The Jsonb newtype is an indication that the Haskell
type it's applied to should be stored as a PGjsonb.
Instances
| FromJSON x => FromValue PGjsonb (Jsonb x) Source # | |
| Eq hask => Eq (Jsonb hask) Source # | |
| Ord hask => Ord (Jsonb hask) Source # | |
Defined in Squeal.PostgreSQL.PG | |
| Read hask => Read (Jsonb hask) Source # | |
| Show hask => Show (Jsonb hask) Source # | |
| Generic (Jsonb hask) Source # | |
| ToJSON hask => Literal (Jsonb hask) Source # | |
| ToJSON x => ToParam (Jsonb x) PGjsonb Source # | |
| type Rep (Jsonb hask) Source # | |
Defined in Squeal.PostgreSQL.PG | |
| type PG (Jsonb hask) Source # | |
Defined in Squeal.PostgreSQL.PG | |
newtype Composite record Source #
The Composite newtype is an indication that the Haskell
type it's applied to should be stored as a PGcomposite.
Constructors
| Composite | |
Fields
| |
Instances
newtype Enumerated enum Source #
The Enumerated newtype is an indication that the Haskell
type it's applied to should be stored as a PGenum.
Constructors
| Enumerated | |
Fields
| |
Instances
The VarArray newtype is an indication that the Haskell
type it's applied to should be stored as a PGvararray.
>>>:kind! PG (VarArray (Vector Double))PG (VarArray (Vector Double)) :: PGType = 'PGvararray ('NotNull 'PGfloat8)
Constructors
| VarArray | |
Fields
| |
Instances
The FixArray newtype is an indication that the Haskell
type it's applied to should be stored as a PGfixarray.
>>>:kind! PG (FixArray ((Double, Double), (Double, Double)))PG (FixArray ((Double, Double), (Double, Double))) :: PGType = 'PGfixarray '[2, 2] ('NotNull 'PGfloat8)
Constructors
| FixArray | |
Fields
| |
Instances
| Eq arr => Eq (FixArray arr) Source # | |
| Ord arr => Ord (FixArray arr) Source # | |
Defined in Squeal.PostgreSQL.PG | |
| Read arr => Read (FixArray arr) Source # | |
| Show arr => Show (FixArray arr) Source # | |
| Generic (FixArray arr) Source # | |
| (ToFixArray x dims ty, ty ~ nullity pg, HasOid pg) => ToParam (FixArray x) (PGfixarray dims ty) Source # | |
Defined in Squeal.PostgreSQL.Binary | |
| FromFixArray dims ty y => FromValue (PGfixarray dims ty) (FixArray y) Source # | |
| type Rep (FixArray arr) Source # | |
Defined in Squeal.PostgreSQL.PG | |
| type PG (FixArray hask) Source # |
|
Defined in Squeal.PostgreSQL.PG | |
Type families
type family LabelsPG (hask :: Type) :: [ConstructorName] where ... Source #
The LabelsPG type family calculates the constructors of a
Haskell enum type.
>>>data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic>>>instance SOP.Generic Schwarma>>>instance SOP.HasDatatypeInfo Schwarma>>>:kind! LabelsPG SchwarmaLabelsPG Schwarma :: [Type.ConstructorName] = '["Beef", "Lamb", "Chicken"]
Equations
| LabelsPG hask = ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask)) |
type family DimPG (hask :: Type) :: [Nat] where ... Source #
DimPG turns Haskell nested homogeneous tuples into a list of lengths.
Equations
| DimPG (x, x) = 2 ': DimPG x | |
| DimPG (x, x, x) = 3 ': DimPG x | |
| DimPG (x, x, x, x) = 4 ': DimPG x | |
| DimPG (x, x, x, x, x) = 5 ': DimPG x | |
| DimPG (x, x, x, x, x, x) = 6 ': DimPG x | |
| DimPG (x, x, x, x, x, x, x) = 7 ': DimPG x | |
| DimPG (x, x, x, x, x, x, x, x) = 8 ': DimPG x | |
| DimPG (x, x, x, x, x, x, x, x, x) = 9 ': DimPG x | |
| DimPG (x, x, x, x, x, x, x, x, x, x) = 10 ': DimPG x | |
| DimPG x = '[] |
type family FixPG (hask :: Type) :: NullityType where ... Source #
Equations
| FixPG (x, x) = FixPG x | |
| FixPG (x, x, x) = FixPG x | |
| FixPG (x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x, x, x, x, x) = FixPG x | |
| FixPG (x, x, x, x, x, x, x, x, x, x, x) = FixPG x | |
| FixPG x = NullPG x |
type family TupleOf (tuple :: [Type]) :: [NullityType] where ... Source #
TupleOf turns a list of Haskell Types into a list of NullityTypes.
type family TupleCodeOf (hask :: Type) (code :: [[Type]]) :: [Type] where ... Source #
TupleCodeOf takes the Code of a haskell Type
and if it's a simple product returns it, otherwise giving a TypeError.
Equations
| TupleCodeOf hask '[tuple] = tuple | |
| TupleCodeOf hask '[] = TypeError (((Text "The type `" :<>: ShowType hask) :<>: Text "' is not a tuple type.") :$$: Text "It is a void type with no constructors.") | |
| TupleCodeOf hask (_ ': (_ ': _)) = TypeError (((Text "The type `" :<>: ShowType hask) :<>: Text "' is not a tuple type.") :$$: Text "It is a sum type with more than one constructor.") |
type family ConstructorsOf (datatype :: DatatypeInfo) :: [ConstructorInfo] where ... Source #
Calculates constructors of a datatype.
Equations
| ConstructorsOf (ADT _module _datatype constructors) = constructors | |
| ConstructorsOf (Newtype _module _datatype constructor) = '[constructor] |
type family ConstructorNameOf (constructor :: ConstructorInfo) :: ConstructorName where ... Source #
Calculates the name of a nullary constructor, otherwise generates a type error.
Equations
| ConstructorNameOf (Constructor name) = name | |
| ConstructorNameOf (Infix name _assoc _fix) = TypeError (Text "ConstructorNameOf error: non-nullary constructor " :<>: Text name) | |
| ConstructorNameOf (Record name _fields) = TypeError (Text "ConstructorNameOf error: non-nullary constructor " :<>: Text name) |
type family ConstructorNamesOf (constructors :: [ConstructorInfo]) :: [ConstructorName] where ... Source #
Calculate the names of nullary constructors.
Equations
| ConstructorNamesOf '[] = '[] | |
| ConstructorNamesOf (constructor ': constructors) = ConstructorNameOf constructor ': ConstructorNamesOf constructors |