hpqtypes-extras 1.6.0.0 → 1.6.1.0
raw patch · 4 files changed
+26/−9 lines, 4 filesdep +semigroupsdep ~basedep ~hpqtypesPVP ok
version bump matches the API change (PVP)
Dependencies added: semigroups
Dependency ranges changed: base, hpqtypes
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- hpqtypes-extras.cabal +5/−3
- src/Database/PostgreSQL/PQTypes/Checks/Util.hs +6/−2
- src/Database/PostgreSQL/PQTypes/Utils/NubList.hs +11/−4
CHANGELOG.md view
@@ -1,3 +1,7 @@+# hpqtypes-extras-1.6.1.0 (2018-03-18)+* Add support for GHC 8.4.1.+* Drop support for GHC 7.8.+ # hpqtypes-extras-1.6.0.0 (2018-01-25) * Introduce `checkPKPresence` to enforce primary keys on all tables supplied to `checkDatabase` * Introduce an options data type, `ExtrasOptions`
hpqtypes-extras.cabal view
@@ -1,5 +1,5 @@ name: hpqtypes-extras-version: 1.6.0.0+version: 1.6.1.0 synopsis: Extra utilities for hpqtypes library description: The following extras for hpqtypes library: .@@ -20,7 +20,8 @@ category: Database build-type: Simple cabal-version: >=1.10-tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+tested-with: GHC == 7.10.3, GHC == 8.0.2,+ GHC == 8.2.2, GHC == 8.4.1 Source-repository head Type: git@@ -51,6 +52,7 @@ , Database.PostgreSQL.PQTypes.Utils.NubList build-depends: base < 5+ , hpqtypes >= 1.5.2.0 , base16-bytestring , bytestring , containers@@ -58,12 +60,12 @@ , data-default , exceptions , fields-json- , hpqtypes >= 1.5.0 , lifted-base , log-base >= 0.7 , monad-control >= 1.0.0.0 , mtl , safe+ , semigroups >= 0.16 , text , text-show
src/Database/PostgreSQL/PQTypes/Checks/Util.hs view
@@ -20,6 +20,7 @@ import TextShow import qualified Data.List as L import qualified Data.Text as T+import qualified Data.Semigroup as SG import Database.PostgreSQL.PQTypes.Model import Database.PostgreSQL.PQTypes@@ -27,9 +28,12 @@ -- | A (potentially empty) list of error messages. newtype ValidationResult = ValidationResult [Text] +instance SG.Semigroup ValidationResult where+ (ValidationResult a) <> (ValidationResult b) = ValidationResult (a ++ b)+ instance Monoid ValidationResult where- mempty = ValidationResult []- mappend (ValidationResult a) (ValidationResult b) = ValidationResult (a ++ b)+ mempty = ValidationResult []+ mappend = (SG.<>) topMessage :: Text -> Text -> ValidationResult -> ValidationResult topMessage objtype objname = \case
src/Database/PostgreSQL/PQTypes/Utils/NubList.hs view
@@ -12,6 +12,7 @@ import qualified Text.Read as R import qualified Data.Set as Set+import qualified Data.Semigroup as SG {- This module is a copy-paste fork of Distribution.Utils.NubList in Cabal@@ -38,11 +39,17 @@ overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a overNubList f (NubList list) = toNubList . f $ list +instance Ord a => SG.Semigroup (NubList a) where+ (NubList xs) <> (NubList ys) = NubList $ xs `listUnion` ys+ where+ listUnion :: (Ord a) => [a] -> [a] -> [a]+ listUnion a b = a+ ++ ordNubBy id (filter (`Set.notMember` (Set.fromList a)) b)++ instance Ord a => Monoid (NubList a) where- mempty = NubList []- (NubList xs) `mappend` (NubList ys) = NubList $ xs `listUnion` ys- where listUnion :: (Ord a) => [a] -> [a] -> [a]- listUnion a b = a ++ (ordNubBy id) (filter (`Set.notMember` (Set.fromList a)) b)+ mempty = NubList []+ mappend = (SG.<>) instance Show a => Show (NubList a) where show (NubList list) = show list