groundhog-inspector 0.7.1.1 → 0.7.1.2
raw patch · 3 files changed
+29/−16 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Database/Groundhog/Inspector.hs +24/−14
- changelog +3/−0
- groundhog-inspector.cabal +2/−2
Database/Groundhog/Inspector.hs view
@@ -148,8 +148,9 @@ UniquePrimary _ -> True _ -> False -- try primary key, then constraints, then indexes- uniq = case filter (isPrimary . uniqueDefType) uniqs' ++ filter ((== UniqueConstraint) . uniqueDefType) uniqs' ++ uniqs' of- [] -> error $ "mkUniqueKeyPhantomName: " ++ show tName ++ "uniques list must be not empty"+ filterUnique f = filter (f . uniqueDefType)+ uniq = case filterUnique isPrimary uniqs' ++ filterUnique (== UniqueConstraint) uniqs' ++ filterUnique (== UniqueIndex) uniqs' of+ [] -> error $ "mkChooseReferencedUnique: " ++ show tName ++ " uniques list must be not empty" (u:_) -> u in uniq , mkUniqueKeyPhantomName = \(_, tName) uniq -> let@@ -233,11 +234,11 @@ [] -> Nothing [ref] -> Just ref refs' -> error $ "Column " ++ c ++ " in table " ++ show tName ++ " participates in multiple references: " ++ show refs'- getReferencedUnique parentName parentInfo parentCols = mkChooseReferencedUnique parentName uniqs where- uniqs = filter (haveSameElems (==) (map (Left . colName) parentCols) . uniqueDefFields) $ tableUniques parentInfo+ refUniqueMatch ref u = haveSameElems (==) (map (Left . snd) $ referencedColumns ref) $ uniqueDefFields u+ getReferencedUnique parentName parentInfo ref = mkChooseReferencedUnique parentName uniqs where+ uniqs = filter (refUniqueMatch ref) $ tableUniques parentInfo isReferenced u = Fold.any getRefs tables where- compareRef ref = referencedTableName ref == tName- && haveSameElems (==) (map (Left . snd) $ referencedColumns ref) (uniqueDefFields u)+ compareRef ref = referencedTableName ref == tName && refUniqueMatch ref u getRefs = any (compareRef . snd) . tableReferences uniquePhantoms = if generateUniqueKeysPhantoms then map mkPhantom uniqueKeys else [] where entity = ConT $ mkName $ mkEntityName tName@@ -245,7 +246,7 @@ v = mkName "v" name = mkName $ mkUniqueKeyPhantomName tName u phantom = ConT ''UniqueMarker `AppT` entity- c = ForallC [] [EqualP (VarT v) phantom] $ NormalC name []+ c = ForallC [] [equalP' (VarT v) phantom] $ NormalC name [] uniqueKeys = filter isReferenced $ map (mkChooseReferencedUnique tName) $ groupBy ((==) `on` sort . uniqueDefFields) uniqueDefs@@ -271,7 +272,7 @@ _ -> foldl AppT (TupleT (length childCols)) $ map mkType childCols mkKeyType parentInfo = typ' where entity = ConT $ mkName $ mkEntityName parentName- uniq = getReferencedUnique parentName parentInfo parentCols+ uniq = getReferencedUnique parentName parentInfo ref typ = if uniqueDefType uniq == UniquePrimary True then ConT ''AutoKey `AppT` entity else ConT ''Key `AppT` entity `AppT` (ConT ''Unique `AppT` (ConT $ mkName $ mkUniqueKeyPhantomName parentName uniq))@@ -282,6 +283,15 @@ parentCols = getCols parentInfo $ map snd $ referencedColumns ref Nothing -> (mkName $ mkFieldName tName $ colName c, NotStrict, mkType c):go cs +equalP' :: Type -> Type -> Pred+equalP' t1 t2 =+#if MIN_VERSION_template_haskell(2, 10, 0)+ foldl AppT EqualityT [t1, t2]+#else+ EqualP t1 t2+#endif++ generateMapping :: (PersistBackend m, SchemaAnalyzer m) => ReverseNamingStyle -> Map QualifiedName TableInfo -> m (Map QualifiedName PSEntityDef) generateMapping style tables = do m <- getMigrationPack@@ -306,12 +316,11 @@ [] -> (Just Nothing, Nothing) [Left name] -> (Nothing, Just name) _ -> error $ "More than one autoincremented column for " ++ show tName ++ ": " ++ show idColumns- -- create keys from uniques only if there are references to them. Autoincremented keys is processed separately, so we ignore it.- getReferencedUnique parentName parentInfo parentCols = mkChooseReferencedUnique parentName uniqs where- uniqs = filter (haveSameElems (==) (map (Left . colName) parentCols) . uniqueDefFields) $ tableUniques parentInfo+ refUniqueMatch ref u = haveSameElems (==) (map (Left . snd) $ referencedColumns ref) $ uniqueDefFields u+ getReferencedUnique parentName parentInfo ref = mkChooseReferencedUnique parentName uniqs where+ uniqs = filter (refUniqueMatch ref) $ tableUniques parentInfo isReferenced u = Fold.any getRefs tables where- compareRef ref = referencedTableName ref == tName- && haveSameElems (==) (map (Left . snd) $ referencedColumns ref) (uniqueDefFields u)+ compareRef ref = referencedTableName ref == tName && refUniqueMatch ref u getRefs = any (compareRef . snd) . tableReferences uniqueKeyDefs = map mkUniqueKeyDef uniqueKeys where mkUniqueKeyDef u = PSUniqueKeyDef (mkUniqueName tName (fromJust $ elemIndex u uniqueDefs) u) Nothing Nothing Nothing Nothing Nothing (isDef u)@@ -320,6 +329,7 @@ isDef u = case autoKey of Just Nothing | u == defaultUnique -> Just True _ -> Nothing+ -- create keys from uniques only if there are references to them. Autoincremented key is processed separately, so we ignore it. uniqueKeys = filter isReferenced $ map (mkChooseReferencedUnique tName) $ groupBy ((==) `on` sort . uniqueDefFields) uniqueDefs@@ -334,7 +344,7 @@ go (c:cs) = case getReference $ colName c of Just ref -> (case Map.lookup parentName tables of Just parentInfo -> let- uniq = getReferencedUnique parentName parentInfo parentCols+ uniq = getReferencedUnique parentName parentInfo ref parentCols = getCols parentInfo $ map snd $ referencedColumns ref in if uniqueDefType uniq == UniquePrimary True then autoKeyRef
changelog view
@@ -1,3 +1,6 @@+0.7.1.2+* Compatibility with template-haskell-2.10+ 0.7.1.1 * Add schema argument to groundhog_inspector
groundhog-inspector.cabal view
@@ -1,5 +1,5 @@ name: groundhog-inspector-version: 0.7.1.1+version: 0.7.1.2 license: BSD3 license-file: LICENSE author: Boris Lykah <lykahb@gmail.com>@@ -16,7 +16,7 @@ changelog Flag sqlite- Description: analyze Slite+ Description: analyze SQLite Default: True Flag postgresql