generic-lens 0.3.0.0 → 0.3.0.1

raw patch · 14 files changed

+103/−84 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +3/−3
• generic-lens.cabal +1/−1
• src/Data/Generics/Internal/Families/Count.hs +8/−20
• src/Data/Generics/Internal/Families/Has.hs +13/−26
• src/Data/Generics/Internal/HList.hs +20/−2
• src/Data/Generics/Internal/Lens.hs +1/−1
• src/Data/Generics/Product/Any.hs +1/−0
• src/Data/Generics/Product/Fields.hs +2/−2
• src/Data/Generics/Product/Positions.hs +3/−3
• src/Data/Generics/Product/Subtype.hs +1/−1
• src/Data/Generics/Product/Typed.hs +2/−2
• src/Data/Generics/Sum/Any.hs +1/−0
• src/Data/Generics/Sum/Constructors.hs +2/−5
• src/Data/Generics/Sum/Typed.hs +45/−18

@@ -175,10 +175,10 @@ type Age  = Int  data Dog = MkDog { name :: Name, age :: Age } deriving (Generic, Show)-data Animal = Dog Dog | Cat (Name, Age) | Duck Age deriving (Generic, Show)+data Animal = Dog Dog | Cat Name Age | Duck Age deriving (Generic, Show)  shep = Dog (MkDog "Shep" 4)-mog = Cat ("Mog", 5)+mog = Cat "Mog" 5 donald = Duck 4 ``` @@ -193,7 +193,7 @@ Just ("Mog",5)  >>> _Ctor @"Cat" # ("Garfield", 6) :: Animal-Cat ("Garfield",6)+Cat "Garfield" 6  >>> donald ^? _Ctor @"Giraffe" error:

@@ -1,5 +1,5 @@ name:                 generic-lens-version:              0.3.0.0+version:              0.3.0.1 synopsis:             Generic data-structure operations exposed as lenses. description:          This package uses the GHC 8 Generic representation to derive various operations on data structures with a lens interface, including structural subtype relationship between records and positional indexing into arbitrary product types. 

@@ -21,8 +21,13 @@   ) where  import GHC.Generics-import GHC.TypeLits +import Data.Type.Bool     (If)+import Data.Type.Equality (type (==))+import GHC.TypeLits       (TypeError, ErrorMessage (..))++import Data.Generics.Internal.HList+ type family CountTotalType t f :: Count where   CountTotalType t (S1 _ (Rec0 t))     = 'One@@ -49,29 +54,12 @@         )  type family CountPartialType t f :: Count where-  CountPartialType t (S1 _ (Rec0 t))-    = 'One-  CountPartialType t (l :*: r)-    = CountPartialType t l <|> CountPartialType t r   CountPartialType t (l :+: r)     = CountPartialType t l <|> CountPartialType t r-  CountPartialType t (S1 _ _)-    = 'None-  CountPartialType t (C1 _ f)-    = CountPartialType t f+  CountPartialType t (C1 m f)+    = If (t == ListToTuple (GCollect f)) 'One 'None   CountPartialType t (D1 _ f)     = CountPartialType t f-  CountPartialType t (Rec0 _)-    = 'None-  CountPartialType t U1-    = 'None-  CountPartialType t V1-    = 'None-  CountPartialType t f-    = TypeError-        (     'ShowType f-        ':<>: 'Text " is not a valid GHC.Generics representation type"-        )  data Count   = None

@@ -17,14 +17,18 @@ module Data.Generics.Internal.Families.Has   ( HasTotalFieldP   , HasTotalTypeP-  , HasPartialTypeP+  , HasPartialTypeTupleP   , HasCtorP   ) where -import Data.Type.Bool (type (||), type (&&)) import GHC.Generics-import GHC.TypeLits +import Data.Type.Bool     (type (||), type (&&))+import Data.Type.Equality (type (==))+import GHC.TypeLits       (Symbol, TypeError, ErrorMessage (..))++import Data.Generics.Internal.HList+ type family HasTotalFieldP (field :: Symbol) f :: Bool where   HasTotalFieldP field (S1 ('MetaSel ('Just field) _ _ _) _)     = 'True@@ -75,30 +79,13 @@         ':<>: 'Text " is not a valid GHC.Generics representation type"         ) -type family HasPartialTypeP a f :: Bool where-  HasPartialTypeP t (S1 meta (Rec0 t))-    = 'True-  HasPartialTypeP t (l :*: r)-    = HasPartialTypeP t l || HasPartialTypeP t r-  HasPartialTypeP t (l :+: r)-    = HasPartialTypeP t l || HasPartialTypeP t r-  HasPartialTypeP t (S1 _ _)-    = 'False-  HasPartialTypeP t (C1 m f)-    = HasPartialTypeP t f-  HasPartialTypeP t (D1 m f)-    = HasPartialTypeP t f-  HasPartialTypeP t (Rec0 _)-    = 'False-  HasPartialTypeP t U1-    = 'False-  HasPartialTypeP t V1+type family HasPartialTypeTupleP a f :: Bool where+  HasPartialTypeTupleP t (l :+: r)+    = HasPartialTypeTupleP t l || HasPartialTypeTupleP t r+  HasPartialTypeTupleP t (C1 m f)+    = t == ListToTuple (GCollect f)+  HasPartialTypeTupleP t _     = 'False-  HasPartialTypeP t f-    = TypeError-        (     'ShowType f-        ':<>: 'Text " is not a valid GHC.Generics representation type"-        )  type family HasCtorP (ctor :: Symbol) f :: Bool where   HasCtorP ctor (C1 ('MetaCons ctor _ _) _)

@@ -29,7 +29,7 @@   , GCollectible (..)   ) where -import Data.Kind+import Data.Kind (Type) import GHC.Generics  data HList (xs :: [Type]) where@@ -67,74 +67,87 @@ -- * Convert tuples to/from HLists  class ListTuple (tuple :: Type) (as :: [Type]) | as -> tuple where+  type ListToTuple as :: Type   tupleToList :: tuple -> HList as   listToTuple :: HList as -> tuple  instance ListTuple () '[] where+  type ListToTuple '[] = ()   tupleToList _ = Nil   listToTuple _ = ()  instance ListTuple a '[a] where+  type ListToTuple '[a] = a   tupleToList a     = a :> Nil   listToTuple (a :> Nil)     = a  instance ListTuple (a, b) '[a, b] where+  type ListToTuple '[a, b] = (a, b)   tupleToList (a, b)     = a :> b :> Nil   listToTuple (a :> b :> Nil)     = (a, b)  instance ListTuple (a, b, c) '[a, b, c] where+  type ListToTuple '[a, b, c] = (a, b, c)   tupleToList (a, b, c)     = a :> b :> c :> Nil   listToTuple (a :> b :> c :> Nil)     = (a, b, c)  instance ListTuple (a, b, c, d) '[a, b, c, d] where+  type ListToTuple '[a, b, c, d] = (a, b, c, d)   tupleToList (a, b, c, d)     = a :> b :> c :> d:> Nil   listToTuple (a :> b :> c :> d :> Nil)     = (a, b, c, d)  instance ListTuple (a, b, c, d, e) '[a, b, c, d, e] where+  type ListToTuple '[a, b, c, d, e] = (a, b, c, d, e)   tupleToList (a, b, c, d, e)     = a :> b :> c :> d:> e :> Nil   listToTuple (a :> b :> c :> d :> e :> Nil)     = (a, b, c, d, e)  instance ListTuple (a, b, c, d, e, f) '[a, b, c, d, e, f] where+  type ListToTuple '[a, b, c, d, e, f] = (a, b, c, d, e, f)   tupleToList (a, b, c, d, e, f)     = a :> b :> c :> d:> e :> f :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> Nil)     = (a, b, c, d, e, f)  instance ListTuple (a, b, c, d, e, f, g) '[a, b, c, d, e, f, g] where+  type ListToTuple '[a, b, c, d, e, f, g] = (a, b, c, d, e, f, g)   tupleToList (a, b, c, d, e, f, g)     = a :> b :> c :> d:> e :> f :> g :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> g :> Nil)     = (a, b, c, d, e, f, g)  instance ListTuple (a, b, c, d, e, f, g, h) '[a, b, c, d, e, f, g, h] where+  type ListToTuple '[a, b, c, d, e, f, g, h] = (a, b, c, d, e, f, g, h)   tupleToList (a, b, c, d, e, f, g, h)     = a :> b :> c :> d:> e :> f :> g :> h :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil)     = (a, b, c, d, e, f, g, h)  instance ListTuple (a, b, c, d, e, f, g, h, j) '[a, b, c, d, e, f, g, h, j] where+  type ListToTuple '[a, b, c, d, e, f, g, h, j] = (a, b, c, d, e, f, g, h, j)   tupleToList (a, b, c, d, e, f, g, h, j)     = a :> b :> c :> d:> e :> f :> g :> h :> j :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> Nil)     = (a, b, c, d, e, f, g, h, j)  instance ListTuple (a, b, c, d, e, f, g, h, j, k) '[a, b, c, d, e, f, g, h, j, k] where+  type ListToTuple '[a, b, c, d, e, f, g, h, j, k] = (a, b, c, d, e, f, g, h, j, k)   tupleToList (a, b, c, d, e, f, g, h, j, k)     = a :> b :> c :> d:> e :> f :> g :> h :> j :> k :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> k :> Nil)     = (a, b, c, d, e, f, g, h, j, k)  instance ListTuple (a, b, c, d, e, f, g, h, j, k, l) '[a, b, c, d, e, f, g, h, j, k, l] where+  type ListToTuple '[a, b, c, d, e, f, g, h, j, k, l] = (a, b, c, d, e, f, g, h, j, k, l)   tupleToList (a, b, c, d, e, f, g, h, j, k, l)     = a :> b :> c :> d:> e :> f :> g :> h :> j :> k :> l :> Nil   listToTuple (a :> b :> c :> d :> e :> f :> g :> h :> j :> k :> l :> Nil)@@ -143,6 +156,7 @@ --------------------------------------------------------------------------------  class GCollectible (f :: Type -> Type) (as :: [Type]) | f -> as where+  type GCollect f :: [Type]   gtoCollection   :: f x -> HList as   gfromCollection :: HList as -> f x @@ -152,6 +166,7 @@   , cs ~ (as ++ bs)   , Splittable as bs cs   ) => GCollectible (l :*: r) cs where+  type GCollect (l :*: r) = GCollect l ++ GCollect r    gtoCollection (l :*: r)     = gtoCollection l `append` gtoCollection r@@ -160,14 +175,17 @@     = gfromCollection as :*: gfromCollection bs     where (as, bs) = split cs -instance GCollectible (K1 R a) '[a] where+instance GCollectible (Rec0 a) '[a] where+  type GCollect (Rec0 a) = '[a]   gtoCollection   = (:> Nil) . unK1   gfromCollection = K1 . head'  instance GCollectible U1 '[] where+  type GCollect U1    = '[]   gtoCollection U1    = Nil   gfromCollection Nil = U1  instance GCollectible f as => GCollectible (M1 m meta f) as where+  type GCollect (M1 m meta f) = GCollect f   gtoCollection   = gtoCollection . unM1   gfromCollection = M1 . gfromCollection

@@ -18,7 +18,7 @@ import Control.Applicative   (Const(..)) import Data.Functor.Identity (Identity(..)) import Data.Profunctor       (Choice(right'), Profunctor(dimap))-import GHC.Generics          ((:*:)(..), Generic(..), K1(..), M1(..), Rep, (:+:)(..))+import GHC.Generics          ((:*:)(..), (:+:)(..), Generic(..), K1(..), M1(..), Rep)  -- | Type alias for lens type Lens' s a

@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes    #-} {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MonoLocalBinds         #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE PolyKinds              #-} {-# LANGUAGE ScopedTypeVariables    #-}

@@ -36,9 +36,9 @@ import Data.Generics.Internal.Families import Data.Generics.Internal.Lens -import Data.Kind+import Data.Kind    (Constraint, Type) import GHC.Generics-import GHC.TypeLits+import GHC.TypeLits (Symbol, ErrorMessage(..), TypeError)  --  $example --  @

@@ -36,10 +36,10 @@  import Data.Generics.Internal.Lens -import Data.Kind-import Data.Type.Bool+import Data.Kind      (Constraint, Type)+import Data.Type.Bool (If, type (&&), Not) import GHC.Generics-import GHC.TypeLits+import GHC.TypeLits   (type (<=?), type (+), Nat, TypeError, ErrorMessage(..))  --  $example --  @

@@ -57,7 +57,7 @@ import Data.Generics.Internal.Lens import Data.Generics.Product.Fields -import Data.Kind+import Data.Kind (Type) import GHC.Generics  -- |Structural subtype relationship

@@ -36,9 +36,9 @@ import Data.Generics.Internal.Families import Data.Generics.Internal.Lens -import Data.Kind+import Data.Kind    (Constraint, Type) import GHC.Generics-import GHC.TypeLits+import GHC.TypeLits (TypeError, ErrorMessage (..))  --  $example --  @

@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes    #-} {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MonoLocalBinds         #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE PolyKinds              #-} {-# LANGUAGE ScopedTypeVariables    #-}

@@ -34,9 +34,9 @@ import Data.Generics.Internal.HList import Data.Generics.Internal.Lens -import Data.Kind+import Data.Kind    (Constraint, Type) import GHC.Generics-import GHC.TypeLits+import GHC.TypeLits (Symbol, TypeError, ErrorMessage (..))  --  $example --  @@@ -121,9 +121,6 @@   _GCtor = _GSumCtor @ctor @l @r @a @(HasCtorP ctor l)  instance GAsConstructor ctor f a => GAsConstructor ctor (M1 D meta f) a where-  _GCtor = mIso . _GCtor @ctor--instance GAsConstructor ctor f a => GAsConstructor ctor (M1 S meta f) a where   _GCtor = mIso . _GCtor @ctor  class GSumAsConstructor (ctor :: Symbol) l r a (contains :: Bool) | ctor l r contains -> a where

@@ -11,6 +11,8 @@ {-# LANGUAGE TypeOperators          #-} {-# LANGUAGE UndecidableInstances   #-} +{-# LANGUAGE DeriveGeneric   #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Generics.Sum.Typed@@ -34,14 +36,14 @@   , GAsType (..)   ) where +import Data.Kind+import GHC.Generics+import GHC.TypeLits (TypeError, ErrorMessage (..))+ import Data.Generics.Internal.Families import Data.Generics.Internal.HList import Data.Generics.Internal.Lens -import Data.Kind-import GHC.Generics-import GHC.TypeLits- --  $example --  @ --    module Example where@@ -51,7 +53,7 @@ -- --    data Animal --      = Dog Dog---      | Cat (Name, Age)+--      | Cat Name Age --      | Duck Age --      deriving (Generic, Show) --@@ -116,27 +118,52 @@ -- |As 'AsType' but over generic representations as defined by "GHC.Generics". class GAsType (f :: Type -> Type) a where   _GTyped :: Prism' (f x) a+  _GTyped = prism ginjectTyped gprojectTyped +  ginjectTyped  :: a -> f x+  gprojectTyped :: f x -> Either (f x) a+ instance-  ( GCollectible f '[a]+  ( GCollectible f as+  , ListTuple a as   ) => GAsType (M1 C meta f) a where -  _GTyped = prism (M1 . gfromCollection . tupleToList) (Right . listToTuple @_ @'[a] . gtoCollection . unM1)+  ginjectTyped+    = M1 . gfromCollection . tupleToList+  gprojectTyped+    = Right . listToTuple @_ @as . gtoCollection . unM1 -instance GSumAsType l r a (HasPartialTypeP a l) => GAsType (l :+: r) a where-  _GTyped = _GSumTyped @l @r @a @(HasPartialTypeP a l)+instance GSumAsType (HasPartialTypeTupleP a l) l r a => GAsType (l :+: r) a where+  ginjectTyped+    = ginjectSumTyped @(HasPartialTypeTupleP a l) @l @r @a+  gprojectTyped+    = gprojectSumTyped @(HasPartialTypeTupleP a l) @l @r @a  instance GAsType f a => GAsType (M1 D meta f) a where-  _GTyped = mIso . _GTyped--instance GAsType f a => GAsType (M1 S meta f) a where-  _GTyped = mIso . _GTyped+  ginjectTyped+    = M1 . ginjectTyped+  gprojectTyped+    = either (Left . M1) Right . gprojectTyped . unM1 -class GSumAsType l r a (contains :: Bool) where+class GSumAsType (contains :: Bool) l r a where   _GSumTyped :: Prism' ((l :+: r) x) a+  _GSumTyped = prism (ginjectSumTyped  @contains) (gprojectSumTyped @contains) -instance GAsType l a => GSumAsType l r a 'True where-  _GSumTyped = left . _GTyped+  ginjectSumTyped  :: a -> (l :+: r) x+  gprojectSumTyped :: (l :+: r) x -> Either ((l :+: r) x) a -instance GAsType r a => GSumAsType l r a 'False where-  _GSumTyped = right . _GTyped+instance GAsType l a => GSumAsType 'True l r a where+  ginjectSumTyped+    = L1 . ginjectTyped+  gprojectSumTyped+    = \x -> case x of+        L1 l -> either (Left . L1) Right (gprojectTyped l)+        R1 _ -> Left x++instance GAsType r a => GSumAsType 'False l r a where+  ginjectSumTyped+    = R1 . ginjectTyped+  gprojectSumTyped+    = \x -> case x of+        R1 r -> either (Left . R1) Right (gprojectTyped r)+        L1 _ -> Left x