generic-data 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+266/−97 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• generic-data.cabal +3/−2
• src/Generic/Data.hs +31/−1
• src/Generic/Data/Internal/Generically.hs +103/−0
• src/Generic/Data/Internal/Meta.hs +89/−5
• src/Generic/Data/Internal/Newtype.hs +29/−89
• src/Generic/Data/Internal/Show.hs +1/−0

@@ -0,0 +1,10 @@+# 0.1.1.0++- Add `gconIndex`+- Interface for constructor tags+- Type-level `Meta` accessors+- Add basic `Newtype` functions++# 0.1.0.0++Released generic-data

@@ -1,5 +1,5 @@ name:                generic-data-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Utilities for GHC.Generics description:         This package provides common functions on generic types.                      See README.@@ -11,7 +11,7 @@ copyright:           2018 Li-yao Xia category:            Other build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md, CHANGELOG.md cabal-version:       >=1.10 tested-with:         GHC == 8.0.2, GHC == 8.2.2 @@ -25,6 +25,7 @@     Generic.Data.Internal.Defun     Generic.Data.Internal.Enum     Generic.Data.Internal.Functions+    Generic.Data.Internal.Generically     Generic.Data.Internal.Meta     Generic.Data.Internal.Newtype     Generic.Data.Internal.Prelude

@@ -88,10 +88,16 @@   , Opaque(..)   , Opaque1(..) -    -- * Newtypes+    -- * Carriers of generic instances   , Generically(..)   , Generically1(..) +    -- * Newtype+    -- | Generic pack/unpack.+  , Newtype+  , pack+  , unpack+     -- * Accessing metadata      -- | Using @TypeApplications@.@@ -108,12 +114,36 @@   , gconFixity   , gconIsRecord   , gconNum+  , gconIndex   , Constructors   , GConstructors++    -- *** Constructor tags+  , ConId()+  , conId+  , conIdToInt+  , conIdToString+  , conIdEnum++  -- ** Using type families+  , MetaOf+  , MetaDataName+  , MetaDataModule+  , MetaDataPackage+  , MetaDataNewtype+  , MetaConsName+  , MetaConsFixity+  , MetaConsRecord+  , MetaSelNameM+  , MetaSelName+  , MetaSelUnpack+  , MetaSelSourceStrictness+  , MetaSelStrictness   ) where  import Generic.Data.Internal.Prelude import Generic.Data.Internal.Enum+import Generic.Data.Internal.Generically import Generic.Data.Internal.Meta import Generic.Data.Internal.Show import Generic.Data.Internal.Newtype

@@ -0,0 +1,103 @@+-- | Newtypes with instances implemented using generic combinators.++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Generic.Data.Internal.Generically where++import Control.Applicative+import Data.Functor.Classes+import Data.Semigroup+import GHC.Generics++import Generic.Data.Internal.Prelude+import Generic.Data.Internal.Enum+import Generic.Data.Internal.Show++-- | Type with instances derived via 'Generic'.+newtype Generically a = Generically { unGenerically :: a }++instance Generic a => Generic (Generically a) where+  type Rep (Generically a) = Rep a+  to = Generically . to+  from = from . unGenerically++instance (Generic a, Eq (Rep a ())) => Eq (Generically a) where+  (==) = geq++instance (Generic a, Ord (Rep a ())) => Ord (Generically a) where+  compare = gcompare++instance (Generic a, GShow0 (Rep a)) => Show (Generically a) where+  showsPrec = gshowsPrec++instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where+  (<>) = gmappend++instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where+  mempty = gmempty+  mappend = gmappend'++instance (Generic a, GEnum (Rep a)) => Enum (Generically a) where+  fromEnum = gfromEnum+  toEnum = gtoEnum++instance (Generic a, GBounded (Rep a)) => Bounded (Generically a) where+  minBound = gminBound+  maxBound = gmaxBound++-- | Type with instances derived via 'Generic1'.+newtype Generically1 f a = Generically1 { unGenerically1 :: f a }++instance Generic (f a) => Generic (Generically1 f a) where+  type Rep (Generically1 f a) = Rep (f a)+  to = Generically1 . to+  from = from . unGenerically1++instance Generic1 f => Generic1 (Generically1 f) where+  type Rep1 (Generically1 f) = Rep1 f+  to1 = Generically1 . to1+  from1 = from1 . unGenerically1++instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where+  liftEq = gliftEq++instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where+  (==) = eq1++instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where+  liftCompare = gliftCompare++instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where+  compare = compare1++instance (Generic1 f, GShow1 (Rep1 f)) => Show1 (Generically1 f) where+  liftShowsPrec = gliftShowsPrec++instance (Generic1 f, GShow1 (Rep1 f), Show a) => Show (Generically1 f a) where+  showsPrec = showsPrec1++instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where+  fmap = gfmap+  (<$) = gconstmap++instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where+  pure = gpure+  (<*>) = gap+#if MIN_VERSION_base(4,10,0)+  liftA2 = gliftA2+#endif++instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where+  empty = gempty+  (<|>) = galt++instance (Generic1 f, Foldable (Rep1 f)) => Foldable (Generically1 f) where+  foldMap = gfoldMap+  foldr = gfoldr++instance (Generic1 f, Traversable (Rep1 f)) => Traversable (Generically1 f) where+  traverse = gtraverse+  sequenceA = gsequenceA

@@ -5,6 +5,7 @@ {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}  {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PolyKinds #-}@@ -18,6 +19,7 @@  import Data.Proxy import GHC.Generics+import GHC.TypeLits (Symbol)  -- | Name of the first data constructor in a type as a string. --@@ -98,24 +100,47 @@ gconNum :: forall a. Constructors a => Int gconNum = gConNum @(Rep a) +-- | Index of a constructor.+--+-- @+-- 'gconIndex' Nothing = 0+-- 'gconIndex' (Just "test") = 1+-- @+gconIndex :: forall a. Constructors a => a -> Int+gconIndex = conIdToInt . conId+ -- | An opaque identifier for a constructor. newtype ConId a = ConId Int   deriving (Eq, Ord) +-- | Identifier of a constructor.+conId :: forall a. Constructors a => a -> ConId a+conId = toConId . gConId . from++-- | Index of a constructor, given its identifier.+-- See also 'gconIndex'. conIdToInt :: forall a. ConId a -> Int conIdToInt (ConId i) = i +-- | Name of a constructor. See also 'gconName'.+conIdToString :: forall a. Constructors a => ConId a -> String+conIdToString = gConIdToString . fromConId++-- | All constructor identifiers.+--+-- @+-- 'gconNum' \@a = length ('conIdEnum' \@a)+-- @ conIdEnum :: forall a. Constructors a => [ConId a] conIdEnum = fmap ConId [0 .. n]   where     ConId n = conIdMax @a -conIdToString :: forall a. Constructors a => ConId a -> String-conIdToString = gConIdToString . fromConId--conId :: forall a. Constructors a => a -> ConId a-conId = toConId . gConId . from+-- | This must not be called on an empty type.+conIdMin :: forall a. Constructors a => ConId a+conIdMin = ConId 0 +-- | This must not be called on an empty type. conIdMax :: forall a. Constructors a => ConId a conIdMax = toConId gConIdMax @@ -138,6 +163,9 @@ reGConId :: GConId r -> GConId s reGConId (GConId i) = GConId i +gConIdMin :: forall r. GConstructors r => GConId r+gConIdMin = GConId 0+ gConIdMax :: forall r. GConstructors r => GConId r gConIdMax = GConId (gConNum @r - 1) @@ -180,3 +208,59 @@   gConNum = 1   gConFixity = conFixity   gConIsRecord = conIsRecord++-- * Type families++-- | 'Meta' field of the 'M1' type constructor.+type family MetaOf (f :: * -> *) :: Meta where+  MetaOf (M1 i d f) = d++-- Variable names borrowed from the documentation on 'Meta'.++-- | Name of the data type ('MetaData').+type family MetaDataName (m :: Meta) :: Symbol where+  MetaDataName ('MetaData n _m _p _nt) = n++-- | Name of the module where the data type is defined ('MetaData')+type family MetaDataModule (m :: Meta) :: Symbol where+  MetaDataModule ('MetaData _n m _p _nt) = m++-- | Name of the package where the data type is defined ('MetaData')+type family MetaDataPackage (m :: Meta) :: Symbol where+  MetaDataPackage ('MetaData _n _m p _nt) = p++-- | @True@ if the data type is a newtype ('MetaData').+type family MetaDataNewtype (m :: Meta) :: Bool where+  MetaDataNewtype ('MetaData _n _m _p nt) = nt++-- | Name of the constructor ('MetaCons').+type family MetaConsName (m :: Meta) :: Symbol where+  MetaConsName ('MetaCons n _f _s) = n++-- | Fixity of the constructor ('MetaCons').+type family MetaConsFixity (m :: Meta) :: FixityI where+  MetaConsFixity ('MetaCons _n f s) = f++-- | @True@ for a record constructor ('MetaCons').+type family MetaConsRecord (m :: Meta) :: Bool where+  MetaConsRecord ('MetaCons _n _f s) = s++-- | @Just@ the name of the record field, if it is one ('MetaSel').+type family MetaSelNameM (m :: Meta) :: Maybe Symbol where+  MetaSelNameM ('MetaSel mn _su _ss _ds) = mn++-- | Name of the record field; undefined for non-record fields ('MetaSel').+type family MetaSelName (m :: Meta) :: Symbol where+  MetaSelName ('MetaSel ('Just n) _su _ss _ds) = n++-- | Unpackedness annotation of a field ('MetaSel').+type family MetaSelUnpack (m :: Meta) :: SourceUnpackedness where+  MetaSelUnpack ('MetaSel _mn su _ss _ds) = su++-- | Strictness annotation of a field ('MetaSel').+type family MetaSelSourceStrictness (m :: Meta) :: SourceStrictness where+  MetaSelSourceStrictness ('MetaSel _mn _su ss _ds) = ss++-- | Inferred strictness of a field ('MetaSel').+type family MetaSelStrictness (m :: Meta) :: DecidedStrictness where+  MetaSelStrictness ('MetaSel _mn _su _ss ds) = ds

@@ -1,103 +1,43 @@--- | Newtypes with instances implemented using generic combinators.--{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}--module Generic.Data.Internal.Newtype where--import Control.Applicative-import Data.Functor.Classes-import Data.Semigroup-import GHC.Generics--import Generic.Data.Internal.Prelude-import Generic.Data.Internal.Enum-import Generic.Data.Internal.Show---- | Type with instances derived via 'Generic'.-newtype Generically a = Generically { unGenerically :: a }--instance Generic a => Generic (Generically a) where-  type Rep (Generically a) = Rep a-  to = Generically . to-  from = from . unGenerically--instance (Generic a, Eq (Rep a ())) => Eq (Generically a) where-  (==) = geq--instance (Generic a, Ord (Rep a ())) => Ord (Generically a) where-  compare = gcompare--instance (Generic a, GShow0 (Rep a)) => Show (Generically a) where-  showsPrec = gshowsPrec--instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where-  (<>) = gmappend--instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where-  mempty = gmempty-  mappend = gmappend'--instance (Generic a, GEnum (Rep a)) => Enum (Generically a) where-  fromEnum = gfromEnum-  toEnum = gtoEnum--instance (Generic a, GBounded (Rep a)) => Bounded (Generically a) where-  minBound = gminBound-  maxBound = gmaxBound---- | Type with instances derived via 'Generic1'.-newtype Generically1 f a = Generically1 { unGenerically1 :: f a }--instance Generic (f a) => Generic (Generically1 f a) where-  type Rep (Generically1 f a) = Rep (f a)-  to = Generically1 . to-  from = from . unGenerically1--instance Generic1 f => Generic1 (Generically1 f) where-  type Rep1 (Generically1 f) = Rep1 f-  to1 = Generically1 . to1-  from1 = from1 . unGenerically1+{-# LANGUAGE UndecidableSuperClasses #-} -instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where-  liftEq = gliftEq+-- | Pack/unpack newtypes. -instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where-  (==) = eq1+module Generic.Data.Internal.Newtype where -instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where-  liftCompare = gliftCompare+import Data.Coerce (Coercible, coerce)+import Data.Kind (Constraint)+import GHC.Generics (Generic(..), D1, C1, S1, K1)+import GHC.TypeLits (TypeError, ErrorMessage(..)) -instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where-  compare = compare1+import Generic.Data.Internal.Meta (MetaDataNewtype, MetaOf) -instance (Generic1 f, GShow1 (Rep1 f)) => Show1 (Generically1 f) where-  liftShowsPrec = gliftShowsPrec+-- | Class of newtypes.+class (Generic a, Coercible a (Old a), Newtype' a) => Newtype a+instance (Generic a, Coercible a (Old a), Newtype' a) => Newtype a -instance (Generic1 f, GShow1 (Rep1 f), Show a) => Show (Generically1 f a) where-  showsPrec = showsPrec1+type Old a = GOld (Rep a) -instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where-  fmap = gfmap-  (<$) = gconstmap+type family GOld (f :: * -> *) where+  GOld (D1 _d (C1 _c (S1 _s (K1 _i b)))) = b -instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where-  pure = gpure-  (<*>) = gap-#if MIN_VERSION_base(4,10,0)-  liftA2 = gliftA2-#endif+type Newtype' a = NewtypeErr a (MetaDataNewtype (MetaOf (Rep a))) -instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where-  empty = gempty-  (<|>) = galt+type family NewtypeErr a (b :: Bool) :: Constraint where+  NewtypeErr a 'True = ()+  NewtypeErr a 'False = TypeError+    ('Text "The type " ':<>: 'ShowType a ':<>: 'Text " is not a newtype.") -instance (Generic1 f, Foldable (Rep1 f)) => Foldable (Generically1 f) where-  foldMap = gfoldMap-  foldr = gfoldr+-- | Generic newtype destructor.+unpack :: Newtype a => a -> Old a+unpack = coerce -instance (Generic1 f, Traversable (Rep1 f)) => Traversable (Generically1 f) where-  traverse = gtraverse-  sequenceA = gsequenceA+-- | Generic newtype constructor.+pack :: Newtype a => Old a -> a+pack = coerce

@@ -31,6 +31,7 @@ -- | Generic representation of 'Show' types. type GShow0 = GShow Proxy +-- | Generic 'liftShowsPrec'. gliftShowsPrec   :: (Generic1 f, GShow1 (Rep1 f))   => (Int -> a -> ShowS) -> ([a] -> ShowS)