diff --git a/src/Database/Beam/AutoMigrate.hs b/src/Database/Beam/AutoMigrate.hs index a0c0d9c..e02360c 100644 --- a/src/Database/Beam/AutoMigrate.hs +++ b/src/Database/Beam/AutoMigrate.hs @@ -569,6 +569,10 @@ renderDataType = \case PgSpecificType (PgEnumeration (EnumerationName ty)) -> ty -- oid PgSpecificType PgOid -> "oid" + -- Arrays + SqlArrayType (SqlArrayType _ _) _ -> error "beam-automigrate: invalid nested array." + SqlArrayType _ 0 -> error "beam-automigrate: array with zero dimensions" + SqlArrayType t d -> renderDataType t <> mconcat (replicate (fromIntegral d) "[]") evalMigration :: Monad m => Migration m -> m (Either MigrationError [WithPriority Edit]) evalMigration m = do diff --git a/src/Database/Beam/AutoMigrate/Compat.hs b/src/Database/Beam/AutoMigrate/Compat.hs index 1bb0fb2..64768ba 100644 --- a/src/Database/Beam/AutoMigrate/Compat.hs +++ b/src/Database/Beam/AutoMigrate/Compat.hs @@ -20,6 +20,7 @@ import Data.Time (LocalTime, TimeOfDay, UTCTime) import Data.Time.Calendar (Day) import Data.Typeable import Data.UUID +import Data.Vector (Vector) import Data.Word import qualified Database.Beam as Beam import Database.Beam.AutoMigrate.Types @@ -245,6 +246,15 @@ instance HasColumnType (Pg.PgRange Pg.PgTsTzRange a) where instance HasColumnType (Pg.PgRange Pg.PgDateRange a) where defaultColumnType _ = PgSpecificType PgRangeDate +-- +-- support for arrays +-- + +instance HasColumnType a => HasColumnType (Vector a) where + defaultColumnType _ = case defaultColumnType (Proxy @a) of + SqlArrayType t d -> SqlArrayType t (d + 1) + t -> SqlArrayType t 1 + -- -- Support for 'SqlSerial'. \"SERIAL\" is treated by Postgres as syntactic sugar for: --- diff --git a/src/Database/Beam/AutoMigrate/Postgres.hs b/src/Database/Beam/AutoMigrate/Postgres.hs index 5860780..38f51c0 100644 --- a/src/Database/Beam/AutoMigrate/Postgres.hs +++ b/src/Database/Beam/AutoMigrate/Postgres.hs @@ -123,7 +123,7 @@ tableColumnsQ :: Pg.Query tableColumnsQ = fromString $ unlines - [ "SELECT attname, atttypid, atttypmod, attnotnull, pg_catalog.format_type(atttypid, atttypmod) ", + [ "SELECT attname, atttypid, atttypmod, attndims, attnotnull, pg_catalog.format_type(atttypid, atttypmod) ", "FROM pg_catalog.pg_attribute att ", "WHERE att.attrelid=? AND att.attnum>0 AND att.attisdropped='f' " ] @@ -249,9 +249,9 @@ getSchema conn = do Map Pg.Oid (EnumerationName, Enumeration) -> AllDefaults -> Columns -> - (ByteString, Pg.Oid, Int, Bool, ByteString) -> + (ByteString, Pg.Oid, Int, Int, Bool, ByteString) -> IO Columns - getColumns tName enumData defaultData c (attname, atttypid, atttypmod, attnotnull, format_type) = do + getColumns tName enumData defaultData c (attname, atttypid, atttypmod, attndims, attnotnull, format_type) = do -- /NOTA BENE(adn)/: The atttypmod - 4 was originally taken from 'beam-migrate' -- (see: https://github.com/tathougies/beam/blob/d87120b58373df53f075d92ce12037a98ca709ab/beam-postgres/Database/Beam/Postgres/Migrate.hs#L343) -- but there are cases where this is not correct, for example in the case of bitstrings. @@ -272,7 +272,8 @@ getSchema conn = do case asum [ pgSerialTyColumnType atttypid mbDefault, pgTypeToColumnType atttypid mbPrecision, - pgEnumTypeToColumnType enumData atttypid + pgEnumTypeToColumnType enumData atttypid, + pgArrayTypeToColumnType atttypid mbPrecision attndims ] of Just cType -> do let nullConstraint = if attnotnull then S.fromList [NotNull] else mempty @@ -378,6 +379,13 @@ pgTypeToColumnType oid width | otherwise = Nothing +pgArrayTypeToColumnType :: Pg.Oid -> Maybe Int -> Int -> Maybe ColumnType +pgArrayTypeToColumnType oid width dims = case Pg.staticTypeInfo oid of + Just (Pg.Array _ _ _ _ subTypeInfo) -> case pgTypeToColumnType (Pg.typoid subTypeInfo) width of + Just columnType -> Just $ SqlArrayType columnType (fromIntegral dims) + _ -> Nothing + _ -> Nothing + -- -- Constraints discovery -- diff --git a/src/Database/Beam/AutoMigrate/Types.hs b/src/Database/Beam/AutoMigrate/Types.hs index 92af36d..4ff37a9 100644 --- a/src/Database/Beam/AutoMigrate/Types.hs +++ b/src/Database/Beam/AutoMigrate/Types.hs @@ -141,6 +141,8 @@ data ColumnType PgSpecificType PgDataType | -- | An enumeration implemented with text-based encoding. DbEnumeration EnumerationName Enumeration + | -- | Array type. + SqlArrayType ColumnType Word deriving (Show, Eq, Generic) data PgDataType