beam-automigrate 0.1.4.0 → 0.1.5.0

raw patch · 6 files changed

+65/−15 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• beam-automigrate.cabal +1/−1
• src/Database/Beam/AutoMigrate.hs +5/−0
• src/Database/Beam/AutoMigrate/Compat.hs +2/−1
• src/Database/Beam/AutoMigrate/Postgres.hs +40/−13
• src/Database/Beam/AutoMigrate/Types.hs +11/−0

@@ -1,5 +1,11 @@ # Revision history for beam-automigrate +## 0.1.5.0++* Add ltree column type+* Add vector column type+* Fix ghc 9.2.8 build+ ## 0.1.4.0  * [#52](https://github.com/obsidiansystems/beam-automigrate/pull/52) Support sql arrays

@@ -1,5 +1,5 @@ name:               beam-automigrate-version:            0.1.4.0+version:            0.1.5.0 license-file:       LICENSE build-type:         Simple cabal-version:      2.0

@@ -569,6 +569,11 @@   PgSpecificType (PgEnumeration (EnumerationName ty)) -> ty   -- oid   PgSpecificType PgOid -> "oid"+  -- ltree+  PgSpecificType PgLTree -> "ltree"+  -- vector+  PgSpecificType (PgVector Nothing) -> "vector"+  PgSpecificType (PgVector (Just n)) -> mconcat ["vector(", T.pack . show $ n, ")"]   -- Arrays   SqlArrayType (SqlArrayType _ _) _ -> error "beam-automigrate: invalid nested array."   SqlArrayType _ 0 -> error "beam-automigrate: array with zero dimensions"

@@ -86,7 +86,8 @@  instance   ( IsMaybe a ~ nullary,-    HasSchemaConstraints' nullary a+    HasSchemaConstraints' nullary a,+    Ord (SchemaConstraint a)   ) =>   HasSchemaConstraints a   where

@@ -202,17 +202,39 @@         "WHERE sch_child.nspname = current_schema() ORDER BY c.conname "       ] +-- | Return the names and OIDs of all user defined types in the public namespace+--+-- This lets us work with types that come from extensions, regardless of when the extension is added.+-- Without this, the OIDs of these types could shift underneath us.+extensionTypeNamesQ :: Pg.Query+extensionTypeNamesQ =+  fromString $+    unlines+      [ "SELECT ty.oid, ty.typname ",+        "FROM pg_type ty ",+        "INNER JOIN pg_namespace ns ON ty.typnamespace = ns.oid ",+        "WHERE ns.nspname = 'public' AND ty.typcategory = 'U' "+      ]+ -- | Connects to a running PostgreSQL database and extract the relevant 'Schema' out of it. getSchema :: Pg.Connection -> IO Schema getSchema conn = do   allTableConstraints <- getAllConstraints conn   allDefaults <- getAllDefaults conn+  extensionTypeData <- Pg.fold_ conn extensionTypeNamesQ mempty getExtension   enumerationData <- Pg.fold_ conn enumerationsQ mempty getEnumeration   sequences <- Pg.fold_ conn sequencesQ mempty getSequence   tables <--    Pg.fold_ conn userTablesQ mempty (getTable allDefaults enumerationData allTableConstraints)+    Pg.fold_ conn userTablesQ mempty (getTable allDefaults extensionTypeData enumerationData allTableConstraints)   pure $ Schema tables (M.fromList $ M.elems enumerationData) sequences   where+    getExtension ::+     Map Pg.Oid ExtensionTypeName ->+     (Pg.Oid, Text) ->+     IO (Map Pg.Oid ExtensionTypeName)+    getExtension allExtensions (oid, name) =+      pure $ M.insert oid (ExtensionTypeName name) allExtensions+     getEnumeration ::       Map Pg.Oid (EnumerationName, Enumeration) ->       (Text, Pg.Oid, V.Vector Text) ->@@ -232,26 +254,28 @@      getTable ::       AllDefaults ->+      Map Pg.Oid ExtensionTypeName ->       Map Pg.Oid (EnumerationName, Enumeration) ->       AllTableConstraints ->       Tables ->       (Pg.Oid, Text) ->       IO Tables-    getTable allDefaults enumData allTableConstraints allTables (oid, TableName -> tName) = do+    getTable allDefaults extensionTypeData enumData allTableConstraints allTables (oid, TableName -> tName) = do       pgColumns <- Pg.query conn tableColumnsQ (Pg.Only oid)       newTable <-         Table (fromMaybe noTableConstraints (M.lookup tName allTableConstraints))-          <$> foldlM (getColumns tName enumData allDefaults) mempty pgColumns+          <$> foldlM (getColumns tName extensionTypeData enumData allDefaults) mempty pgColumns       pure $ M.insert tName newTable allTables      getColumns ::       TableName ->+      Map Pg.Oid ExtensionTypeName ->       Map Pg.Oid (EnumerationName, Enumeration) ->       AllDefaults ->       Columns ->       (ByteString, Pg.Oid, Int, Int, Bool, ByteString) ->       IO Columns-    getColumns tName enumData defaultData c (attname, atttypid, atttypmod, attndims, attnotnull, format_type) = do+    getColumns tName extensionTypeData 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.@@ -271,9 +295,9 @@        case asum         [ pgSerialTyColumnType atttypid mbDefault,-          pgTypeToColumnType atttypid mbPrecision,+          pgTypeToColumnType extensionTypeData atttypid mbPrecision,           pgEnumTypeToColumnType enumData atttypid,-          pgArrayTypeToColumnType atttypid mbPrecision attndims+          pgArrayTypeToColumnType extensionTypeData atttypid mbPrecision attndims         ] of         Just cType -> do           let nullConstraint = if attnotnull then S.fromList [NotNull] else mempty@@ -310,8 +334,8 @@  -- | Tries to convert from a Postgres' 'Oid' into 'ColumnType'. -- Mostly taken from [beam-migrate](Database.Beam.Postgres.Migrate).-pgTypeToColumnType :: Pg.Oid -> Maybe Int -> Maybe ColumnType-pgTypeToColumnType oid width+pgTypeToColumnType :: Map Pg.Oid ExtensionTypeName -> Pg.Oid -> Maybe Int -> Maybe ColumnType+pgTypeToColumnType extensionTypeData oid width   | Pg.typoid Pg.int2 == oid =     Just (SqlStdType smallIntType)   | Pg.typoid Pg.int4 == oid =@@ -376,12 +400,15 @@     Just (PgSpecificType PgUuid)   | Pg.typoid Pg.oid == oid =     Just (PgSpecificType PgOid)-  | otherwise =-    Nothing+  | M.lookup oid extensionTypeData == Just "ltree" =+    Just (PgSpecificType PgLTree)+  | M.lookup oid extensionTypeData == Just "vector" =+    Just (PgSpecificType . PgVector $ (+ 4) . fromIntegral <$> 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+pgArrayTypeToColumnType :: Map Pg.Oid ExtensionTypeName -> Pg.Oid -> Maybe Int -> Int -> Maybe ColumnType+pgArrayTypeToColumnType extensionTypeData oid width dims = case Pg.staticTypeInfo oid of+  Just (Pg.Array _ _ _ _ subTypeInfo) -> case pgTypeToColumnType extensionTypeData (Pg.typoid subTypeInfo) width of     Just columnType -> Just $ SqlArrayType columnType (fromIntegral dims)     _ -> Nothing   _ -> Nothing

@@ -23,6 +23,7 @@ import Database.Beam.Postgres (Pg, Postgres) import qualified Database.Beam.Postgres.Syntax as Syntax import GHC.Generics hiding (to)+import Numeric.Natural (Natural) import Lens.Micro (Lens', lens, to, _Right) import Lens.Micro.Extras (preview) @@ -157,12 +158,22 @@   | PgUuid   | PgEnumeration EnumerationName   | PgOid+  | PgLTree+  | PgVector (Maybe Natural)  deriving instance Show PgDataType  deriving instance Eq PgDataType  deriving instance Generic PgDataType++newtype ExtensionTypeName = ExtensionTypeName+  { extensionTypeName :: Text+  }+  deriving (Show, Eq, Ord, NFData, Generic)++instance IsString ExtensionTypeName where+  fromString = ExtensionTypeName . T.pack  -- Newtype wrapper to be able to derive appropriate 'HasDefaultSqlDataType' for /Postgres/ enum types. newtype PgEnum a