on dev help sign in
add more cases to PG type family
commitf01894e5b34493d06055c83a98299c51e3ece18f authorEitan Chatav <eitan.chatav@gmail.com> dateFri 24 Aug 2018, 00:43 (8 years ago) parent0833082
2 files changed+41−16
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+39−14
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2
@@ -862,7 +862,7 @@ createTypeEnumFrom
862862 )
863863 => Alias enum
864864 -- ^ 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)
866866createTypeEnumFrom enum = createTypeEnum enum
867867 (SOP.hpure label :: NP PGlabel (LabelsFrom hask))
868868
@@ -912,7 +912,7 @@ createTypeCompositeFrom
912912 , KnownSymbol ty )
913913 => Alias ty
914914 -- ^ 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)
916916createTypeCompositeFrom ty = createTypeComposite ty
917917 (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
918918 :: NP (Aliased (TypeExpression schema)) (PGFieldsFrom hask))
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+39−14
@@ -112,11 +112,14 @@ module Squeal.PostgreSQL.Schema
112112 , PGjsonKey
113113 -- * Embedding
114114 , PG
115− , EnumFrom
115+ , Jsonb
116+ , Composite
117+ , Enumerated
118+ -- , EnumFrom
116119 , LabelsFrom
117− , CompositeFrom
120+ -- , CompositeFrom
118121 , PGFieldsFrom
119− , PGFieldsOf
122+ , RowOf
120123 , PGFieldOf
121124 , ConstructorsOf
122125 , ConstructorNameOf
@@ -140,6 +143,7 @@ import Data.Time
140143import Data.Word (Word16, Word32, Word64)
141144import Data.Type.Bool
142145import Data.UUID.Types (UUID)
146+import Data.Vector (Vector)
143147import Generics.SOP
144148import Generics.SOP.Record
145149import GHC.OverloadedLabels
@@ -712,8 +716,29 @@ type family PG (hask :: Type) :: PGType where
712716 PG UUID = 'PGuuid
713717 PG (NetAddr IP) = 'PGinet
714718 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)))
715736 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}
717742
718743-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with
719744-- nullary constructors, as Postgres enum types
@@ -724,8 +749,8 @@ type family PG (hask :: Type) :: PGType where
724749-- >>> :kind! EnumFrom Schwarma
725750-- EnumFrom Schwarma :: PGType
726751-- = 'PGenum '["Beef", "Lamb", "Chicken"]
727−type family EnumFrom (hask :: Type) :: PGType where
728− EnumFrom hask = 'PGenum (LabelsFrom hask)
752+-- type family EnumFrom (hask :: Type) :: PGType where
753+-- EnumFrom hask = 'PGenum (LabelsFrom hask)
729754
730755-- | The `LabelsFrom` type family calculates the constructors of a
731756-- Haskell enum type.
@@ -755,18 +780,18 @@ type family CompositeFrom (hask :: Type) :: PGType where
755780 CompositeFrom hask = 'PGcomposite (PGFieldsFrom hask)
756781
757782type family PGFieldsFrom (hask :: Type) :: RowType where
758− PGFieldsFrom hask = PGFieldsOf (RecordCodeOf hask)
783+ PGFieldsFrom hask = RowOf (RecordCodeOf hask)
759784
760−type family PGFieldsOf (fields :: [(Symbol, Type)]) :: RowType where
761− PGFieldsOf '[] = '[]
762− PGFieldsOf (field ': fields) = PGFieldOf field ': PGFieldsOf fields
785+type family RowOf (fields :: [(Symbol, Type)]) :: RowType where
786+ RowOf '[] = '[]
787+ RowOf (field ': fields) = PGFieldOf field ': RowOf fields
763788
764789type family PGFieldOf (field :: (Symbol, Type)) :: (Symbol, NullityType) where
765− PGFieldOf (field ::: hask) = field ::: NullityTypeOf hask
790+ PGFieldOf (field ::: hask) = field ::: NullPG hask
766791
767−type family NullityTypeOf (hask :: Type) :: NullityType where
768− NullityTypeOf (Maybe hask) = 'Null (PG hask)
769− NullityTypeOf hask = 'NotNull (PG hask)
792+type family NullPG (hask :: Type) :: NullityType where
793+ NullPG (Maybe hask) = 'Null (PG hask)
794+ NullPG hask = 'NotNull (PG hask)
770795
771796-- | Calculates constructors of a datatype.
772797type family ConstructorsOf (datatype :: Type.DatatypeInfo)