diff --git a/changelog.d/20230715_133657_shane.obrien_QualifiedName2.md b/changelog.d/20230715_133657_shane.obrien_QualifiedName2.md new file mode 100644 index 0000000..84d000b --- /dev/null +++ b/changelog.d/20230715_133657_shane.obrien_QualifiedName2.md @@ -0,0 +1,40 @@ + + + + +### Changed + +- Also use `QualifiedName` for `TypeInformation`.`typeName`, `enumTypeName` and `compositeTypeName`. This also means that `TypeInformation` now has an extra field, `arrayDepth`. + + + + diff --git a/src/Rel8/Expr/Function.hs b/src/Rel8/Expr/Function.hs index fc5e65e..82969f2 100644 --- a/src/Rel8/Expr/Function.hs +++ b/src/Rel8/Expr/Function.hs @@ -29,7 +29,7 @@ import Rel8.Expr.Opaleye ) import Rel8.Schema.HTable (hfoldMap) import Rel8.Schema.Null ( Sql ) -import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName) +import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName) import Rel8.Table (Table, toColumns) import Rel8.Type ( DBType ) @@ -61,7 +61,7 @@ primFunction :: Arguments arguments => QualifiedName -> arguments -> Opaleye.PrimExpr primFunction qualified = Opaleye.FunExpr name . arguments where - name = show (ppQualifiedName qualified) + name = showQualifiedName qualified -- | Construct an expression by applying an infix binary operator to two diff --git a/src/Rel8/Expr/Opaleye.hs b/src/Rel8/Expr/Opaleye.hs index ab5578c..0eaca04 100644 --- a/src/Rel8/Expr/Opaleye.hs +++ b/src/Rel8/Expr/Opaleye.hs @@ -25,7 +25,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) ) import Rel8.Schema.Null ( Unnullify, Sql ) import Rel8.Type ( DBType, typeInformation ) -import Rel8.Type.Information ( TypeInformation(..) ) +import Rel8.Type.Information (TypeInformation(..), showTypeName) -- profunctors import Data.Profunctor ( Profunctor, dimap ) @@ -47,8 +47,8 @@ scastExpr = sunsafeCastExpr sunsafeCastExpr :: () => TypeInformation (Unnullify b) -> Expr a -> Expr b -sunsafeCastExpr TypeInformation {typeName} = - fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr +sunsafeCastExpr info = + fromPrimExpr . Opaleye.CastExpr (showTypeName info) . toPrimExpr -- | Unsafely construct an expression from literal SQL. diff --git a/src/Rel8/Expr/Sequence.hs b/src/Rel8/Expr/Sequence.hs index 51c92a4..f79c3b2 100644 --- a/src/Rel8/Expr/Sequence.hs +++ b/src/Rel8/Expr/Sequence.hs @@ -13,7 +13,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye -- rel8 import Rel8.Expr ( Expr ) import Rel8.Expr.Opaleye (fromPrimExpr) -import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName) +import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName) -- | See https://www.postgresql.org/docs/current/functions-sequence.html @@ -21,5 +21,5 @@ nextval :: QualifiedName -> Expr Int64 nextval name = fromPrimExpr $ Opaleye.FunExpr "nextval" - [ Opaleye.ConstExpr (Opaleye.StringLit (show (ppQualifiedName name))) + [ Opaleye.ConstExpr (Opaleye.StringLit (showQualifiedName name)) ] diff --git a/src/Rel8/Schema/QualifiedName.hs b/src/Rel8/Schema/QualifiedName.hs index 533521b..25421dd 100644 --- a/src/Rel8/Schema/QualifiedName.hs +++ b/src/Rel8/Schema/QualifiedName.hs @@ -7,6 +7,7 @@ module Rel8.Schema.QualifiedName ( QualifiedName (..) , ppQualifiedName + , showQualifiedName ) where @@ -47,3 +48,7 @@ ppQualifiedName QualifiedName {..} = Opaleye.ppTable Opaleye.SqlTable { sqlTableSchemaName = schema , sqlTableName = name } + + +showQualifiedName :: QualifiedName -> String +showQualifiedName = show . ppQualifiedName \ No newline at end of file diff --git a/src/Rel8/Table/Opaleye.hs b/src/Rel8/Table/Opaleye.hs index 909dc50..e10fc7d 100644 --- a/src/Rel8/Table/Opaleye.hs +++ b/src/Rel8/Table/Opaleye.hs @@ -55,7 +55,7 @@ import Rel8.Schema.QualifiedName (QualifiedName (QualifiedName)) import Rel8.Schema.Spec ( Spec(..) ) import Rel8.Schema.Table ( TableSchema(..), ppTable ) import Rel8.Table ( Table, fromColumns, toColumns ) -import Rel8.Type.Information ( typeName ) +import Rel8.Type.Information (showTypeName) -- semigroupoids import Data.Functor.Apply ( WrappedApplicative(..) ) @@ -135,7 +135,7 @@ valuesspec :: Table Expr a => Opaleye.Valuesspec a a valuesspec = dimap toColumns fromColumns $ htraversePWithField (traverseFieldP . Opaleye.valuesspecFieldType . typeName) where - typeName = Rel8.Type.Information.typeName . info . hfield hspecs + typeName = showTypeName . info . hfield hspecs view :: Selects names exprs => names -> exprs diff --git a/src/Rel8/Type.hs b/src/Rel8/Type.hs index 43fd839..177543e 100644 --- a/src/Rel8/Type.hs +++ b/src/Rel8/Type.hs @@ -2,6 +2,7 @@ {-# language FlexibleInstances #-} {-# language MonoLocalBinds #-} {-# language MultiWayIf #-} +{-# language OverloadedStrings #-} {-# language StandaloneKindSignatures #-} {-# language UndecidableInstances #-} @@ -87,6 +88,7 @@ instance DBType Bool where { encode = Opaleye.ConstExpr . Opaleye.BoolLit , decode = Hasql.bool , typeName = "bool" + , arrayDepth = 0 } @@ -96,6 +98,7 @@ instance DBType Char where { encode = Opaleye.ConstExpr . Opaleye.StringLit . pure , decode = Hasql.char , typeName = "char" + , arrayDepth = 0 } @@ -105,6 +108,7 @@ instance DBType Int16 where { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger , decode = Hasql.int2 , typeName = "int2" + , arrayDepth = 0 } @@ -114,6 +118,7 @@ instance DBType Int32 where { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger , decode = Hasql.int4 , typeName = "int4" + , arrayDepth = 0 } @@ -123,6 +128,7 @@ instance DBType Int64 where { encode = Opaleye.ConstExpr . Opaleye.IntegerLit . toInteger , decode = Hasql.int8 , typeName = "int8" + , arrayDepth = 0 } @@ -136,6 +142,7 @@ instance DBType Float where | otherwise -> Opaleye.NumericLit $ realToFrac x , decode = Hasql.float4 , typeName = "float4" + , arrayDepth = 0 } @@ -149,6 +156,7 @@ instance DBType Double where | otherwise -> Opaleye.NumericLit $ realToFrac x , decode = Hasql.float8 , typeName = "float8" + , arrayDepth = 0 } @@ -158,6 +166,7 @@ instance DBType Scientific where { encode = Opaleye.ConstExpr . Opaleye.NumericLit , decode = Hasql.numeric , typeName = "numeric" + , arrayDepth = 0 } @@ -169,6 +178,7 @@ instance DBType UTCTime where formatTime defaultTimeLocale "'%FT%T%QZ'" , decode = Hasql.timestamptz , typeName = "timestamptz" + , arrayDepth = 0 } @@ -180,6 +190,7 @@ instance DBType Day where formatTime defaultTimeLocale "'%F'" , decode = Hasql.date , typeName = "date" + , arrayDepth = 0 } @@ -191,6 +202,7 @@ instance DBType LocalTime where formatTime defaultTimeLocale "'%FT%T%Q'" , decode = Hasql.timestamp , typeName = "timestamp" + , arrayDepth = 0 } @@ -202,6 +214,7 @@ instance DBType TimeOfDay where formatTime defaultTimeLocale "'%T%Q'" , decode = Hasql.time , typeName = "time" + , arrayDepth = 0 } @@ -213,6 +226,7 @@ instance DBType CalendarDiffTime where formatTime defaultTimeLocale "'%bmon %0Es'" , decode = CalendarDiffTime 0 . realToFrac <$> Hasql.interval , typeName = "interval" + , arrayDepth = 0 } @@ -222,6 +236,7 @@ instance DBType Text where { encode = Opaleye.ConstExpr . Opaleye.StringLit . Text.unpack , decode = Hasql.text , typeName = "text" + , arrayDepth = 0 } @@ -251,6 +266,7 @@ instance DBType ByteString where { encode = Opaleye.ConstExpr . Opaleye.ByteStringLit , decode = Hasql.bytea , typeName = "bytea" + , arrayDepth = 0 } @@ -267,6 +283,7 @@ instance DBType UUID where { encode = Opaleye.ConstExpr . Opaleye.StringLit . UUID.toString , decode = Hasql.uuid , typeName = "uuid" + , arrayDepth = 0 } @@ -279,6 +296,7 @@ instance DBType Value where Lazy.unpack . Lazy.decodeUtf8 . Aeson.encode , decode = Hasql.jsonb , typeName = "jsonb" + , arrayDepth = 0 } -- | Corresponds to @inet@ @@ -288,6 +306,7 @@ instance DBType (NetAddr IP) where Opaleye.ConstExpr . Opaleye.StringLit . printNetAddr , decode = Hasql.inet , typeName = "inet" + , arrayDepth = 0 } diff --git a/src/Rel8/Type/Array.hs b/src/Rel8/Type/Array.hs index e170bf1..09e06a8 100644 --- a/src/Rel8/Type/Array.hs +++ b/src/Rel8/Type/Array.hs @@ -25,13 +25,18 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye -- rel8 import Rel8.Schema.Null ( Unnullify, Nullity( Null, NotNull ) ) -import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation ) +import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName) +import Rel8.Type.Information + ( TypeInformation(..) + , parseTypeInformation + , showTypeName + ) array :: Foldable f => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr array info = - Opaleye.CastExpr (arrayType info <> "[]") . + Opaleye.CastExpr (showQualifiedName (arrayType info) <> "[]") . Opaleye.ArrayExpr . map (encodeArrayElement info) . toList {-# INLINABLE array #-} @@ -54,7 +59,8 @@ listTypeInformation nullity info@TypeInformation {encode, decode} = NotNull -> Opaleye.ArrayExpr . fmap (encodeArrayElement info . encode) - , typeName = arrayType info <> "[]" + , typeName = arrayType info + , arrayDepth = 1 } where null = Opaleye.ConstExpr Opaleye.NullLit @@ -72,12 +78,10 @@ nonEmptyTypeInformation nullity = isArray :: TypeInformation a -> Bool -isArray = \case - (reverse . typeName -> ']' : '[' : _) -> True - _ -> False +isArray = (> 0) . arrayDepth -arrayType :: TypeInformation a -> String +arrayType :: TypeInformation a -> QualifiedName arrayType info | isArray info = "record" | otherwise = typeName info @@ -107,7 +111,7 @@ extractArrayElement info minus a b = Opaleye.BinExpr (Opaleye.:-) a b len = Opaleye.FunExpr "length" . pure substr s a b = Opaleye.FunExpr "substr" [s, a, b] - cast = Opaleye.CastExpr (typeName info) + cast = Opaleye.CastExpr (showTypeName info) text = Opaleye.CastExpr "text" input unrow = Opaleye.CaseExpr diff --git a/src/Rel8/Type/Composite.hs b/src/Rel8/Type/Composite.hs index 3482e0b..74f3112 100644 --- a/src/Rel8/Type/Composite.hs +++ b/src/Rel8/Type/Composite.hs @@ -34,6 +34,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye import Rel8.Expr ( Expr ) import Rel8.Expr.Opaleye ( castExpr, fromPrimExpr, toPrimExpr ) import Rel8.Schema.HTable ( HTable, hfield, hspecs, htabulate, htabulateA ) +import Rel8.Schema.QualifiedName (QualifiedName) import Rel8.Schema.Name ( Name( Name ) ) import Rel8.Schema.Null ( Nullity( Null, NotNull ) ) import Rel8.Schema.Result ( Result ) @@ -71,6 +72,7 @@ instance DBComposite a => DBType (Composite a) where { decode = Hasql.composite (Composite . fromResult @_ @(HKD a Expr) <$> decoder) , encode = encoder . litHTable . toResult @_ @(HKD a Expr) . unComposite , typeName = compositeTypeName @a + , arrayDepth = 0 } @@ -94,7 +96,7 @@ class (DBType a, HKDable a) => DBComposite a where compositeFields :: HKD a Name -- | The name of the composite type that @a@ maps to. - compositeTypeName :: String + compositeTypeName :: QualifiedName -- | Collapse a 'HKD' into a PostgreSQL composite type. diff --git a/src/Rel8/Type/Enum.hs b/src/Rel8/Type/Enum.hs index 3324079..0a59cc7 100644 --- a/src/Rel8/Type/Enum.hs +++ b/src/Rel8/Type/Enum.hs @@ -38,6 +38,7 @@ import qualified Hasql.Decoders as Hasql import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye -- rel8 +import Rel8.Schema.QualifiedName (QualifiedName) import Rel8.Type ( DBType, typeInformation ) import Rel8.Type.Eq ( DBEq ) import Rel8.Type.Information ( TypeInformation(..) ) @@ -76,6 +77,7 @@ instance DBEnum a => DBType (Enum a) where enumValue @a . unEnum , typeName = enumTypeName @a + , arrayDepth = 0 } @@ -101,7 +103,7 @@ class (DBType a, Enumable a) => DBEnum a where enumValue = gshow @(Rep a) . from -- | The name of the PostgreSQL @enum@ type that @a@ maps to. - enumTypeName :: String + enumTypeName :: QualifiedName -- | Types that are sum types, where each constructor is unary (that is, has no diff --git a/src/Rel8/Type/Information.hs b/src/Rel8/Type/Information.hs index 4765167..0aac79e 100644 --- a/src/Rel8/Type/Information.hs +++ b/src/Rel8/Type/Information.hs @@ -6,12 +6,14 @@ module Rel8.Type.Information ( TypeInformation(..) , mapTypeInformation , parseTypeInformation + , showTypeName ) where -- base import Data.Bifunctor ( first ) import Data.Kind ( Type ) +import Data.Semigroup (mtimesDefault) import Prelude -- hasql @@ -20,6 +22,9 @@ import qualified Hasql.Decoders as Hasql -- opaleye import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye +-- rel8 +import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName) + -- text import qualified Data.Text as Text @@ -33,8 +38,10 @@ data TypeInformation a = TypeInformation -- ^ How to encode a single Haskell value as a SQL expression. , decode :: Hasql.Value a -- ^ How to deserialize a single result back to Haskell. - , typeName :: String + , typeName :: QualifiedName -- ^ The name of the SQL type. + , arrayDepth :: Word + -- ^ How many levels of @[]@ (or 0 if type is not array). } @@ -59,9 +66,15 @@ mapTypeInformation = parseTypeInformation . fmap pure parseTypeInformation :: () => (a -> Either String b) -> (b -> a) -> TypeInformation a -> TypeInformation b -parseTypeInformation to from TypeInformation {encode, decode, typeName} = +parseTypeInformation to from TypeInformation {encode, decode, typeName, arrayDepth} = TypeInformation { encode = encode . from , decode = Hasql.refine (first Text.pack . to) decode , typeName + , arrayDepth } + + +showTypeName :: TypeInformation a -> String +showTypeName TypeInformation {typeName, arrayDepth} = + showQualifiedName typeName <> mtimesDefault arrayDepth "[]" \ No newline at end of file diff --git a/src/Rel8/Type/JSONBEncoded.hs b/src/Rel8/Type/JSONBEncoded.hs index 7530f0d..f9899da 100644 --- a/src/Rel8/Type/JSONBEncoded.hs +++ b/src/Rel8/Type/JSONBEncoded.hs @@ -1,3 +1,4 @@ +{-# language OverloadedStrings #-} {-# language StandaloneKindSignatures #-} module Rel8.Type.JSONBEncoded ( JSONBEncoded(..) ) where @@ -32,4 +33,5 @@ instance (FromJSON a, ToJSON a) => DBType (JSONBEncoded a) where { encode = encode typeInformation . toJSON . fromJSONBEncoded , decode = Hasql.refine (first pack . fmap JSONBEncoded . parseEither parseJSON) Hasql.jsonb , typeName = "jsonb" + , arrayDepth = 0 }