git.iko.soy/squeal
on dev help sign in
add more cases to PG type family
f01894eEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2
compare with dev
unifiedsplit
@@ -862,7 +862,7 @@ createTypeEnumFrom
862 )
862 )
863 => Alias enum
863 => Alias enum
864 -- ^ name of the user defined enumerated type
864 -- ^ name of the user defined enumerated type
865− -> Definition schema (Create enum ('Typedef (EnumFrom hask)) schema)
865+ -> Definition schema (Create enum ('Typedef (PG (Enumerated hask))) schema)
866createTypeEnumFrom enum = createTypeEnum enum
866createTypeEnumFrom enum = createTypeEnum enum
867 (SOP.hpure label :: NP PGlabel (LabelsFrom hask))
867 (SOP.hpure label :: NP PGlabel (LabelsFrom hask))
868
868
@@ -912,7 +912,7 @@ createTypeCompositeFrom
912 , KnownSymbol ty )
912 , KnownSymbol ty )
913 => Alias ty
913 => Alias ty
914 -- ^ name of the user defined composite type
914 -- ^ name of the user defined composite type
915− -> Definition schema (Create ty ( 'Typedef (CompositeFrom hask)) schema)
915+ -> Definition schema (Create ty ( 'Typedef (PG (Composite hask))) schema)
916createTypeCompositeFrom ty = createTypeComposite ty
916createTypeCompositeFrom ty = createTypeComposite ty
917 (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
917 (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
918 :: NP (Aliased (TypeExpression schema)) (PGFieldsFrom hask))
918 :: NP (Aliased (TypeExpression schema)) (PGFieldsFrom hask))
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+39−14
@@ -112,11 +112,14 @@ module Squeal.PostgreSQL.Schema
112 , PGjsonKey
112 , PGjsonKey
113 -- * Embedding
113 -- * Embedding
114 , PG
114 , PG
115+ , Jsonb
116+ , Composite
117+ , Enumerated
115− , EnumFrom
118+ -- , EnumFrom
116 , LabelsFrom
119 , LabelsFrom
117− , CompositeFrom
120+ -- , CompositeFrom
118 , PGFieldsFrom
121 , PGFieldsFrom
119− , PGFieldsOf
122+ , RowOf
120 , PGFieldOf
123 , PGFieldOf
121 , ConstructorsOf
124 , ConstructorsOf
122 , ConstructorNameOf
125 , ConstructorNameOf
@@ -140,6 +143,7 @@ import Data.Time
140import Data.Word (Word16, Word32, Word64)
143import Data.Word (Word16, Word32, Word64)
141import Data.Type.Bool
144import Data.Type.Bool
142import Data.UUID.Types (UUID)
145import Data.UUID.Types (UUID)
146+import Data.Vector (Vector)
143import Generics.SOP
147import Generics.SOP
144import Generics.SOP.Record
148import Generics.SOP.Record
145import GHC.OverloadedLabels
149import GHC.OverloadedLabels
@@ -712,8 +716,29 @@ type family PG (hask :: Type) :: PGType where
712 PG UUID = 'PGuuid
716 PG UUID = 'PGuuid
713 PG (NetAddr IP) = 'PGinet
717 PG (NetAddr IP) = 'PGinet
714 PG Value = 'PGjson
718 PG Value = 'PGjson
719+ PG Jsonb = 'PGjsonb
720+ PG (Vector hask) = 'PGvararray (NullPG hask)
721+ PG (hask, hask) = 'PGfixarray 2 (NullPG hask)
722+ PG (hask, hask, hask) = 'PGfixarray 3 (NullPG hask)
723+ PG (hask, hask, hask, hask) = 'PGfixarray 4 (NullPG hask)
724+ PG (hask, hask, hask, hask, hask) = 'PGfixarray 5 (NullPG hask)
725+ PG (hask, hask, hask, hask, hask, hask) = 'PGfixarray 6 (NullPG hask)
726+ PG (hask, hask, hask, hask, hask, hask, hask) = 'PGfixarray 7 (NullPG hask)
727+ PG (hask, hask, hask, hask, hask, hask, hask, hask)
728+ = 'PGfixarray 8 (NullPG hask)
729+ PG (hask, hask, hask, hask, hask, hask, hask, hask, hask)
730+ = 'PGfixarray 9 (NullPG hask)
731+ PG (hask, hask, hask, hask, hask, hask, hask, hask, hask, hask)
732+ = 'PGfixarray 10 (NullPG hask)
733+ PG (Composite hask) = 'PGcomposite (RowOf (RecordCodeOf hask))
734+ PG (Enumerated hask)
735+ = 'PGenum (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask)))
715 PG ty = TypeError
736 PG ty = TypeError
716− ('Text "There is no Postgres basic type for " ':<>: 'ShowType ty)
737+ ('Text "There is no Postgres type for " ':<>: 'ShowType ty)
738+
739+newtype Jsonb = Jsonb {getJsonb :: Value}
740+newtype Composite record = Composite {getComposite :: record}
741+newtype Enumerated enum = Enumerated {getEnumerated :: enum}
717
742
718-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with
743-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with
719-- nullary constructors, as Postgres enum types
744-- nullary constructors, as Postgres enum types
@@ -724,8 +749,8 @@ type family PG (hask :: Type) :: PGType where
724-- >>> :kind! EnumFrom Schwarma
749-- >>> :kind! EnumFrom Schwarma
725-- EnumFrom Schwarma :: PGType
750-- EnumFrom Schwarma :: PGType
726-- = 'PGenum '["Beef", "Lamb", "Chicken"]
751-- = 'PGenum '["Beef", "Lamb", "Chicken"]
727−type family EnumFrom (hask :: Type) :: PGType where
752+-- type family EnumFrom (hask :: Type) :: PGType where
728− EnumFrom hask = 'PGenum (LabelsFrom hask)
753+-- EnumFrom hask = 'PGenum (LabelsFrom hask)
729
754
730-- | The `LabelsFrom` type family calculates the constructors of a
755-- | The `LabelsFrom` type family calculates the constructors of a
731-- Haskell enum type.
756-- Haskell enum type.
@@ -755,18 +780,18 @@ type family CompositeFrom (hask :: Type) :: PGType where
755 CompositeFrom hask = 'PGcomposite (PGFieldsFrom hask)
780 CompositeFrom hask = 'PGcomposite (PGFieldsFrom hask)
756
781
757type family PGFieldsFrom (hask :: Type) :: RowType where
782type family PGFieldsFrom (hask :: Type) :: RowType where
758− PGFieldsFrom hask = PGFieldsOf (RecordCodeOf hask)
783+ PGFieldsFrom hask = RowOf (RecordCodeOf hask)
759
784
760−type family PGFieldsOf (fields :: [(Symbol, Type)]) :: RowType where
785+type family RowOf (fields :: [(Symbol, Type)]) :: RowType where
761− PGFieldsOf '[] = '[]
786+ RowOf '[] = '[]
762− PGFieldsOf (field ': fields) = PGFieldOf field ': PGFieldsOf fields
787+ RowOf (field ': fields) = PGFieldOf field ': RowOf fields
763
788
764type family PGFieldOf (field :: (Symbol, Type)) :: (Symbol, NullityType) where
789type family PGFieldOf (field :: (Symbol, Type)) :: (Symbol, NullityType) where
765− PGFieldOf (field ::: hask) = field ::: NullityTypeOf hask
790+ PGFieldOf (field ::: hask) = field ::: NullPG hask
766
791
767−type family NullityTypeOf (hask :: Type) :: NullityType where
792+type family NullPG (hask :: Type) :: NullityType where
768− NullityTypeOf (Maybe hask) = 'Null (PG hask)
793+ NullPG (Maybe hask) = 'Null (PG hask)
769− NullityTypeOf hask = 'NotNull (PG hask)
794+ NullPG hask = 'NotNull (PG hask)
770
795
771-- | Calculates constructors of a datatype.
796-- | Calculates constructors of a datatype.
772type family ConstructorsOf (datatype :: Type.DatatypeInfo)
797type family ConstructorsOf (datatype :: Type.DatatypeInfo)