generic-data 0.9.0.0 → 0.9.1.0

raw patch · 12 files changed

+118/−27 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +5/−5
• generic-data.cabal +1/−1
• src/Generic/Data.hs +13/−0
• src/Generic/Data/Internal/Meta.hs +72/−9
• test/bench.hs +0/−1
• test/example.hs +1/−2
• test/inspection.hs +1/−1
• test/lens-surgery.hs +1/−2
• test/microsurgery.hs +1/−2
• test/record.hs +0/−1
• test/unit.hs +14/−3

@@ -1,3 +1,12 @@+# 0.9.1.0++- Fix `conIdToString` (it was completely broken)+- Add `conIdMin` and `conIdMax` representing the leftmost and rightmost+  constructors of a data type.+- Add `NonEmptyType` and `IsEmptyType` to express the constraint that+  a generic type must or must not be empty.+- Reexport `Generic` and `Generic1` for convenience.+ # 0.9.0.0  - Improved definition of `gfoldMap`, `gtraverse`, and `sequenceA`.

@@ -1,4 +1,4 @@-# Generic data types in Haskell [![Hackage](https://img.shields.io/hackage/v/generic-data.svg)](https://hackage.haskell.org/package/generic-data) [![Build Status](https://travis-ci.org/Lysxia/generic-data.svg)](https://travis-ci.org/Lysxia/generic-data)+# Generic data types in Haskell [![Hackage](https://img.shields.io/hackage/v/generic-data.svg)](https://hackage.haskell.org/package/generic-data) [![GitHub CI](https://github.com/Lysxia/generic-data/workflows/CI/badge.svg)](https://github.com/Lysxia/generic-data/actions)  Utilities for `GHC.Generics`. @@ -36,7 +36,6 @@  -- base import Data.Semigroup (Semigroup(..))-import GHC.Generics  -- generic-data import Generic.Data (gmappend)@@ -97,8 +96,7 @@  ```haskell {-# LANGUAGE DeriveGeneric #-}-import GHC.Generic (Generic)-import Generic.Data (gshowsPrec)+import Generic.Data (Generic, gshowsPrec) import Generic.Data.Microsurgery (toData, derecordify)  -- An example record type@@ -123,7 +121,7 @@  ```haskell {-# LANGUAGE DeriveGeneric, DerivingVia #-}-import GHC.Generic (Generic)+import Generic.Data (Generic)  -- Reexported from GHC.Generics  -- Constructors must be visible to use DerivingVia import Generic.Data.Microsurgery (Surgery, Surgery'(..), Generically(..), Derecordify)@@ -162,6 +160,8 @@   [first-class-families](https://hackage.haskell.org/package/first-class-families)   (second one written by me)   libraries for dependently-typed programming in Haskell.+- [coercible-utils](https://hackage.haskell.org/package/coercible-utils):+  utilities for coercible types.  --- 

@@ -1,5 +1,5 @@ name:                generic-data-version:             0.9.0.0+version:             0.9.1.0 synopsis:            Deriving instances with GHC.Generics and related utilities description:   Generic implementations of standard type classes.

@@ -221,6 +221,11 @@   , conIdNamed   , ConIdNamed +  , conIdMin+  , conIdMax+  , NonEmptyType+  , IsEmptyType+   -- ** Using type families   , MetaOf   , MetaDataName@@ -235,6 +240,12 @@   , MetaSelUnpack   , MetaSelSourceStrictness   , MetaSelStrictness++    -- * The @Generic@ class++    -- | Reexported from "GHC.Generics".+  , Generic()+  , Generic1()   ) where  import Generic.Data.Internal.Prelude hiding (gfoldMap, gtraverse, gsequenceA)@@ -247,3 +258,5 @@ import Generic.Data.Internal.Newtype import Generic.Data.Internal.Resolvers import Generic.Data.Internal.Utils++import GHC.Generics (Generic, Generic1)

@@ -1,7 +1,9 @@ {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}  {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -141,22 +143,22 @@ conIdToString :: forall a. Constructors a => ConId a -> String conIdToString = gConIdToString . fromConId --- | All constructor identifiers. This must not be called on an empty type.+-- | All constructor identifiers. -- -- @ -- 'gconNum' \@a = length ('conIdEnum' \@a) -- @ conIdEnum :: forall a. Constructors a => [ConId a]-conIdEnum = fmap ConId [0 .. n]+conIdEnum = fmap ConId [0 .. n-1]   where-    ConId n = conIdMax @a+    n = gConNum @(Rep a) --- | This must not be called on an empty type.-conIdMin :: forall a. Constructors a => ConId a+-- | The first constructor. This must not be called on an empty type.+conIdMin :: forall a. (Constructors a, NonEmptyType "conIdMin" a) => ConId a conIdMin = ConId 0 --- | This must not be called on an empty type.-conIdMax :: forall a. Constructors a => ConId a+-- | The last constructor. This must not be called on an empty type.+conIdMax :: forall a. (Constructors a, NonEmptyType "conIdMax" a) => ConId a conIdMax = toConId gConIdMax  -- | Get a 'ConId' by name.@@ -219,9 +221,9 @@     if i < nf then       gConIdToString @f (GConId i)     else-      gConIdToString @g (GConId (i - nf - 1))+      gConIdToString @g (GConId (i - nf))     where-      GConId nf = gConIdMax @f+      nf = gConNum @f   gConId (L1 x) = reGConId (gConId x)   gConId (R1 y) = let GConId i = gConId y in GConId (nf + 1 + i)     where@@ -239,6 +241,13 @@   gConFixity = conFixity   gConIsRecord = conIsRecord +instance GConstructors V1 where+  gConIdToString x = x `seq` error "gConIdToString: empty type"  -- Input should be empty.+  gConId v = case v of {}+  gConNum = 0+  gConFixity v = case v of {}+  gConIsRecord v = case v of {}+ -- *** Find a constructor tag by name  type ConIdNamed' n t = GConIdNamedIf n t (GConIdNamed n (Rep t))@@ -257,6 +266,60 @@   GConIdNamedIf  n  t 'Nothing = TypeError     ('Text "No constructor named " ':<>: 'ShowType n     ':<>: 'Text " in generic type " ':<>: 'ShowType t)++-- *** Check that a type is not empty++-- | Constraint that a generic type @a@ is not empty.+-- Producing an error message otherwise.+--+-- The 'Symbol' parameter 'fname' is used only for error messages.+--+-- It is implied by the simpler constraint @'IsEmptyType' a ~ 'False@+class    NonEmptyType_ fname a => NonEmptyType fname a+instance NonEmptyType_ fname a => NonEmptyType fname a++-- | Internal definition of 'NonEmptyType'.+-- It is implied by the simpler constraint @'IsEmptyType' a ~ 'False@.+--+-- >>> :set -XTypeFamilies+-- >>> :{+-- conIdMin' :: (Constructors a, IsEmptyType a ~ 'False) => ConId a+-- conIdMin' = conIdMin+-- :}+--+-- >>> :{+-- conIdMax' :: (Constructors a, IsEmptyType a ~ 'False) => ConId a+-- conIdMax' = conIdMax+-- :}+type NonEmptyType_ fname a = (ErrorIfEmpty fname a (IsEmptyType a) ~ '())++-- 'True' if the generic representation is @M1 D _ V1@.+type family GIsEmptyType (r :: k -> *) :: Bool where+  GIsEmptyType (M1 D _d V1) = 'True+  GIsEmptyType (M1 D _d (M1 C _c _f)) = 'False+  GIsEmptyType (M1 D _d (_f :+: _g)) = 'False++-- | 'True' if the generic type @a@ is empty.+type IsEmptyType a = IsEmptyType_ a++-- | Internal definition of 'IsEmptyType'.+type IsEmptyType_ a = GIsEmptyType (Rep a)++-- | Throw an error if the boolean @b@ is true, meaning that the type @a@ is empty.+--+-- Example:+--+-- > ghci> data E deriving Generic+-- > ghci> conIdMin :: ConId E+--+-- Error message:+--+-- > The function 'conIdMin' cannot be used with the empty type E+type family ErrorIfEmpty (fname :: Symbol) (a :: *) (b :: Bool) :: () where+  ErrorIfEmpty fname a 'True = TypeError+    ('Text "The function '" ':<>: 'Text fname+    ':<>: 'Text "' cannot be used with the empty type " ':<>: 'ShowType a)+  ErrorIfEmpty fname a 'False = '()  -- * Type families 

@@ -10,7 +10,6 @@   #-}  import Data.Semigroup (Sum(..))-import GHC.Generics (Generic) import Text.Show (showParen, showString)  import Control.DeepSeq

@@ -8,8 +8,7 @@ #endif  import Data.Semigroup (Semigroup(..))-import GHC.Generics-import Generic.Data (gmappend, Generically(..))+import Generic.Data (Generic, gmappend, Generically(..)) import Generic.Data.Orphans ()  data Foo a = Bar [a] [a] deriving Generic

@@ -15,8 +15,8 @@ {-# LANGUAGE TypeOperators, TypeFamilies #-}  import Control.Applicative (liftA2)-import Data.Coerce (coerce) import GHC.Generics+import Data.Coerce (coerce) import Data.Semigroup (Sum(..), All(..))  import Test.Inspection

@@ -8,13 +8,12 @@  import Data.Coerce (coerce) import Data.Functor.Identity (Identity(..))-import GHC.Generics (Generic) import Test.Tasty import Test.Tasty.HUnit  import Data.Generics.Product (field_) -import Generic.Data (gshowsPrec, Opaque(Opaque))+import Generic.Data (Generic, gshowsPrec, Opaque(Opaque)) import Generic.Data.Microsurgery (onData, toData)  data T = R { f :: Int -> Int } deriving Generic

@@ -10,11 +10,10 @@  -- @DataKinds@ and @TypeApplications@ for @renameFields@ and @renameConstrs@ -import GHC.Generics (Generic) import Test.Tasty import Test.Tasty.HUnit -import Generic.Data (gshowsPrec)+import Generic.Data (Generic, gshowsPrec) import Generic.Data.Microsurgery   ( toData   , derecordify, typeage, renameFields, renameConstrs

@@ -11,7 +11,6 @@ import Data.Functor.Classes import Data.Semigroup import Data.Monoid (Alt(..))-import GHC.Generics (Generic) import Text.Read  import Generic.Data

@@ -13,7 +13,7 @@ import Test.Tasty.HUnit import Text.Read -import GHC.Generics+import GHC.Generics (Fixity(Prefix)) import Generic.Data import Generic.Data.Orphans () @@ -259,12 +259,23 @@       , testCase "conIsRecord" $ False @=? gconIsRecord (Just ())       , testCase "conNum" $ 2 @=? gconNum @(Maybe Int)       ]+  , testGroup "ConId"+      [ testCase "conIdEnum" $ [conId Nothing, conId (Just ())] @?= conIdEnum @(Maybe ())+      , testCase "conIdMin" $ conId (Nothing :: Maybe ()) @?= conIdMin+      , testCase "conIdMax" $ conId (Just ()) @?= conIdMax+      ]+  , let i = conId (Nothing :: Maybe ()) in+    testGroup "ConId (Nothing)"+      [ testCase "conId" $ "ConId 0" @?= show i+      , testCase "conIdToInt" $ 0 @?= conIdToInt i+      , testCase "conIdToString" $ "Nothing" @?= conIdToString i+      , testCase "conIdNamed" $ i @?= conIdNamed @"Nothing"+      ]   , let i = conId (Just ()) in-    testGroup "ConId"+    testGroup "ConId (Just)"       [ testCase "conId" $ "ConId 1" @?= show i       , testCase "conIdToInt" $ 1 @?= conIdToInt i       , testCase "conIdToString" $ "Just" @?= conIdToString i-      , testCase "conIdEnum" $ [conId Nothing, conId (Just ())] @?= conIdEnum @(Maybe ())       , testCase "conIdNamed" $ i @?= conIdNamed @"Just"       ]   ]