groundhog-inspector 0.7.1.2 → 0.8

raw patch · 4 files changed

+46/−27 lines, 4 filesdep ~aeson-prettydep ~groundhogdep ~groundhog-thPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson-pretty, groundhog, groundhog-th, syb

API changes (from Hackage documentation)

Files

• Database/Groundhog/Inspector.hs +36/−20
• changelog +3/−0
• groundhog-inspector.cabal +5/−5
• main/Main.hs +2/−2

@@ -25,7 +25,7 @@   ) where  import Database.Groundhog.Core-import Database.Groundhog.Generic (haveSameElems, findOne, getAutoKeyType)+import Database.Groundhog.Generic (haveSameElems, findOne, getDefaultAutoKeyType) import Database.Groundhog.Generic.Migration import Database.Groundhog.TH (NamingStyle, firstChar, mkTHEntityDef) import Database.Groundhog.TH.Settings@@ -168,7 +168,7 @@ -- | It looks for the references to the tables not contained in the passed map. -- If there are such references and the reference filter function returns True, the corresponding TableInfo is fetched and included into the map. -- The references for the newly added tables are processed in the same way. This function can be useful if your set of tables is created not by 'collectTables'.-followReferencedTables :: SchemaAnalyzer m+followReferencedTables :: (PersistBackend m, SchemaAnalyzer (Conn m))                     => (QualifiedName -> Bool) -- ^ Decides if we follow reference to this table. It can be used to prevent mapping of the referenced audit or system tables                     -> Map QualifiedName TableInfo                     -> m (Map QualifiedName TableInfo)@@ -196,7 +196,7 @@ -- > publicTables  <- collectTables filterRefs (Just "public") -- > websiteTables <- collectTables filterRefs (Just "website") -- > let allTables = publicTables <> websiteTables-collectTables :: SchemaAnalyzer m+collectTables :: (PersistBackend m, SchemaAnalyzer (Conn m))               => (QualifiedName -> Bool) -- ^ Decides if we follow the reference to a table. It can be used to prevent mapping of the referenced audit or system tables               -> Maybe String -- ^ Schema name               -> m (Map QualifiedName TableInfo)@@ -221,7 +221,7 @@               -> Map QualifiedName TableInfo               -> QualifiedName -> TableInfo -> (Dec, [Dec]) generateData' DataCodegenConfig{..} ReverseNamingStyle{..} tables tName tInfo = decs where-  decs = (DataD [] (mkName $ mkEntityName tName) [] [constr] [], uniquePhantoms)+  decs = (dataD' [] (mkName $ mkEntityName tName) [] [constr] [], uniquePhantoms)   constr = RecC (mkName $ mkConstructorName tName) fields -- if a set of columns is referenced, do nothing. If we have a reference to a mapped table, collect all columns and create Key. If reference is to a not mapped table, do nothing -- Drop autogenerated id@@ -242,7 +242,7 @@     getRefs = any (compareRef . snd) . tableReferences   uniquePhantoms = if generateUniqueKeysPhantoms then map mkPhantom uniqueKeys else [] where     entity = ConT $ mkName $ mkEntityName tName-    mkPhantom u = DataD [] name [PlainTV v] [c] [] where+    mkPhantom u = dataD' [] name [PlainTV v] [c] [] where       v = mkName "v"       name = mkName $ mkUniqueKeyPhantomName tName u       phantom = ConT ''UniqueMarker `AppT` entity@@ -259,9 +259,9 @@     go (c:cs) = case getReference $ colName c of       Just ref -> (case Map.lookup parentName tables of         Just parentInfo ->-          (mkName $ mkKeyFieldName tName ref, NotStrict, mkKeyType parentInfo)+          (mkName $ mkKeyFieldName tName ref, notStrict', mkKeyType parentInfo)         Nothing -> -          (mkName $ mkKeyFieldName tName ref, NotStrict, notMappedRefType)+          (mkName $ mkKeyFieldName tName ref, notStrict', notMappedRefType)         ):go (filter (`notElem` childCols) cs) where            parentName = referencedTableName ref@@ -281,7 +281,7 @@               _ | map colNull childCols == [True] -> ConT ''Maybe `AppT` typ -- wrap non-composite keys in Maybe               _ -> notMappedRefType             parentCols = getCols parentInfo $ map snd $ referencedColumns ref-      Nothing -> (mkName $ mkFieldName tName $ colName c, NotStrict, mkType c):go cs+      Nothing -> (mkName $ mkFieldName tName $ colName c, notStrict', mkType c):go cs  equalP' :: Type -> Type -> Pred equalP' t1 t2 =@@ -292,15 +292,15 @@ #endif  -generateMapping :: (PersistBackend m, SchemaAnalyzer m) => ReverseNamingStyle -> Map QualifiedName TableInfo -> m (Map QualifiedName PSEntityDef)+generateMapping :: (PersistBackend m, SchemaAnalyzer (Conn m)) => ReverseNamingStyle -> Map QualifiedName TableInfo -> m (Map QualifiedName PSEntityDef) generateMapping style tables = do   m <- getMigrationPack   return $ generateMappingPure style m tables -generateMappingPure :: DbDescriptor (PhantomDb m) => ReverseNamingStyle -> MigrationPack m -> Map QualifiedName TableInfo -> Map QualifiedName PSEntityDef+generateMappingPure :: DbDescriptor conn => ReverseNamingStyle -> MigrationPack conn -> Map QualifiedName TableInfo -> Map QualifiedName PSEntityDef generateMappingPure style m tables = Map.mapWithKey (generateMapping' style m tables) tables -generateMapping' :: DbDescriptor (PhantomDb m) => ReverseNamingStyle -> MigrationPack m -> Map QualifiedName TableInfo -> QualifiedName -> TableInfo -> PSEntityDef+generateMapping' :: DbDescriptor conn => ReverseNamingStyle -> MigrationPack conn -> Map QualifiedName TableInfo -> QualifiedName -> TableInfo -> PSEntityDef generateMapping' ReverseNamingStyle{..} m@MigrationPack{..} tables tName tInfo = entity where   entity = PSEntityDef (mkEntityName tName) (Just $ snd tName) (fst tName) autoKey (Just uniqueKeyDefs) (Just [constr])   idColumns = (filter ((== UniquePrimary True) . uniqueDefType) $ tableUniques tInfo) >>= uniqueDefFields@@ -357,19 +357,19 @@            parentName = referencedTableName ref -          notMappedRef = PSFieldDef (mkKeyFieldName tName ref) (Just $ colName c) (case colType c of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c) (Just (Just (referencedTableName ref, map snd $ referencedColumns ref), refOnDelete, refOnUpdate))-          notMappedEmbeddedRef = PSFieldDef (mkKeyFieldName tName ref) Nothing Nothing Nothing (Just embeddeds) Nothing (Just (Just (referencedTableName ref, map snd $ referencedColumns ref), refOnDelete, refOnUpdate)) where-            embeddeds = zipWith (\c1 i -> PSFieldDef ("val" ++ show i) (Just $ colName c1) (case colType c1 of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c1) Nothing) childCols [0 :: Int ..]-          mappedEmbeddedRef parentCols = PSFieldDef (mkKeyFieldName tName ref) Nothing Nothing Nothing (Just embeddeds) Nothing (Just (Nothing, refOnDelete, refOnUpdate)) where-            embeddeds = zipWith (\c1 c2 -> PSFieldDef (colName c2) (Just $ colName c1) (showSqlType <$> mfilter (/= colType c2) (Just $ colType c1)) Nothing Nothing (colDefault c1) Nothing) childCols parentCols-          autoKeyRef = PSFieldDef (mkKeyFieldName tName ref) (Just $ colName c) (showSqlType <$> mfilter (/= autoKeyType) (Just $ colType c)) Nothing Nothing (colDefault c) (Just (Nothing, refOnDelete, refOnUpdate)) where-            autoKeyType = getAutoKeyType $ (undefined :: MigrationPack m -> p (PhantomDb m)) m+          notMappedRef = PSFieldDef (mkKeyFieldName tName ref) (Just $ colName c) (case colType c of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c) (Just (Just (referencedTableName ref, map snd $ referencedColumns ref), refOnDelete, refOnUpdate)) Nothing+          notMappedEmbeddedRef = PSFieldDef (mkKeyFieldName tName ref) Nothing Nothing Nothing (Just embeddeds) Nothing (Just (Just (referencedTableName ref, map snd $ referencedColumns ref), refOnDelete, refOnUpdate)) Nothing where+            embeddeds = zipWith (\c1 i -> PSFieldDef ("val" ++ show i) (Just $ colName c1) (case colType c1 of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c1) Nothing Nothing) childCols [0 :: Int ..]+          mappedEmbeddedRef parentCols = PSFieldDef (mkKeyFieldName tName ref) Nothing Nothing Nothing (Just embeddeds) Nothing (Just (Nothing, refOnDelete, refOnUpdate)) Nothing where+            embeddeds = zipWith (\c1 c2 -> PSFieldDef (colName c2) (Just $ colName c1) (showSqlType <$> mfilter (/= colType c2) (Just $ colType c1)) Nothing Nothing (colDefault c1) Nothing Nothing) childCols parentCols+          autoKeyRef = PSFieldDef (mkKeyFieldName tName ref) (Just $ colName c) (showSqlType <$> mfilter (/= autoKeyType) (Just $ colType c)) Nothing Nothing (colDefault c) (Just (Nothing, refOnDelete, refOnUpdate)) Nothing where+            autoKeyType = getDefaultAutoKeyType $ (undefined :: MigrationPack conn -> p conn) m           refOnDelete = mfilter (/= defaultReferenceOnDelete) $ referenceOnDelete ref           refOnUpdate = mfilter (/= defaultReferenceOnUpdate) $ referenceOnUpdate ref                      getCols info cols = map (\cName -> findOne "column" colName cName $ tableColumns info) cols           childCols = getCols tInfo $ map fst $ referencedColumns ref-      Nothing -> PSFieldDef (mkFieldName tName $ colName c) (Just $ colName c) (case colType c of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c) Nothing:go cs+      Nothing -> PSFieldDef (mkFieldName tName $ colName c) (Just $ colName c) (case colType c of DbOther t -> Just $ showOther t; _ -> Nothing) Nothing Nothing (colDefault c) Nothing Nothing:go cs  subtractSame :: THEntityDef -> PSEntityDef -> PSEntityDef subtractSame = subtractEntity where@@ -408,5 +408,21 @@ -- You can use a third-party tool to convert JSON to YAML. showMappings :: [PSEntityDef] -> ByteString showMappings = encodePretty' config where-  config = Config { confIndent = 4, confCompare = keyOrder keys }+  config = Config { confIndent = Spaces 4, confCompare = keyOrder keys }   keys = ["entity", "name", "dbName", "schema", "autoKey", "keyDbName", "type", "embeddedType", "columns", "keys", "fields", "uniques"]++dataD' :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> InstanceDec+dataD' cxt name types constrs derives =+#if MIN_VERSION_template_haskell(2, 11, 0)+  DataD cxt name types Nothing constrs (map ConT derives)+#else+  DataD cxt name types constrs derives+#endif++#if MIN_VERSION_template_haskell(2, 11, 0)+notStrict' :: Bang+notStrict' = Bang NoSourceUnpackedness NoSourceStrictness+#else+notStrict' :: Strict+notStrict' = NotStrict+#endif

@@ -1,3 +1,6 @@+0.8+* Support for GHC 8+ 0.7.1.2 * Compatibility with template-haskell-2.10 

@@ -1,5 +1,5 @@ name:            groundhog-inspector-version:         0.7.1.2+version:         0.8 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -32,14 +32,14 @@                    , bytestring               >= 0.9                    , time                     >= 1.1.4                    , transformers             >= 0.2.1-                   , groundhog                >= 0.7     && < 0.8-                   , groundhog-th             >= 0.7     && < 0.8+                   , groundhog                >= 0.8     && < 0.9+                   , groundhog-th             >= 0.8     && < 0.9                    , template-haskell                    , containers               >= 0.2-                   , aeson-pretty             >= 0.7+                   , aeson-pretty             >= 0.8                    , text                     >= 0.8                    , regex-compat                           < 1.0-                   , syb                      >= 0.3     && < 0.5+                   , syb                      >= 0.3     exposed-modules: Database.Groundhog.Inspector     ghc-options:     -Wall     

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards #-}+{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, FlexibleContexts #-}  module Main where @@ -44,7 +44,7 @@          &= details ["Pass a name of a database. The connection string is an argument to with*Conn. "            , "MySQL connection string is \"ConnectInfo {...}\""] -analyze :: (PersistBackend m, SchemaAnalyzer m, MonadIO m) => Maybe String -> m ()+analyze :: (PersistBackend m, SchemaAnalyzer (Conn m), MonadIO m) => Maybe String -> m () analyze schema = do   tables <- collectTables (const True) schema   -- Analyze tables