generic-lens-core-2.2.1.0: Generically derive traversals, lenses and prisms.
Safe HaskellNone
LanguageHaskell2010

Data.Generics.Product.Internal.Types

Synopsis

Documentation

type family Children (ch :: Type) (a :: Type) :: [Type] Source #

The children of a type are the types of its fields. The Children type family maps a type a to its set of children.

This type family is parameterized by a symbol ch (that can be declared as an empty data type). The symbol ChGeneric provides a default definition. You can create new symbols to override the set of children of abstract, non-generic types.

The following example declares a Custom symbol to redefine Children for some abstract types from the time library.

data Custom
type instance Children Custom a = ChildrenCustom a

type family ChildrenCustom (a :: Type) where
  ChildrenCustom DiffTime        = '[]
  ChildrenCustom NominalDiffTime = '[]
  -- Add more custom mappings here.

  ChildrenCustom a = Children ChGeneric a

To use this definition, replace types with typesUsing @Custom.

Instances

Instances details
type Children ChGeneric a Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

data ChGeneric Source #

The default definition of Children. Primitive types from core libraries have no children, and other types are assumed to be Generic.

Instances

Instances details
HasTypes b a => GHasTypes ChGeneric (Rec0 b :: k -> Type) (Rec0 b :: k -> Type) a a Source #

The default instance for HasTypes acts as a synonym for 'HasTypesUsing ChGeneric', so in most cases this instance should behave the same as the one above. However, there might be overlapping instances defined for HasTypes directly, in which case we want to prefer those instances (even though the custom instances should always be added to HasTypesCustom)

Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k0). Traversal (Rec0 b x) (Rec0 b x) a a Source #

type Children ChGeneric a Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

type family ChildrenDefault (a :: Type) :: [Type] where ... Source #

Equations

ChildrenDefault Char = '[] 
ChildrenDefault Double = '[] 
ChildrenDefault Float = '[] 
ChildrenDefault Integer = '[] 
ChildrenDefault Int = '[] 
ChildrenDefault Int8 = '[] 
ChildrenDefault Int16 = '[] 
ChildrenDefault Int32 = '[] 
ChildrenDefault Int64 = '[] 
ChildrenDefault Word = '[] 
ChildrenDefault Word8 = '[] 
ChildrenDefault Word16 = '[] 
ChildrenDefault Word32 = '[] 
ChildrenDefault Word64 = '[] 
ChildrenDefault Text = '[] 
ChildrenDefault (Param n _) = '[] 
ChildrenDefault a = Defined (Rep a) (NoGeneric a '['Text "arising from a generic traversal.", 'Text "Either derive the instance, or define a custom traversal using HasTypesCustom"]) (ChildrenGeneric (Rep a) '[]) 

type family ChildrenGeneric (f :: k -> Type) (cs :: [Type]) :: [Type] where ... Source #

Equations

ChildrenGeneric (M1 _ _ f) cs = ChildrenGeneric f cs 
ChildrenGeneric (l :*: r) cs = ChildrenGeneric l (ChildrenGeneric r cs) 
ChildrenGeneric (l :+: r) cs = ChildrenGeneric l (ChildrenGeneric r cs) 
ChildrenGeneric (Rec0 a) cs = a ': cs 
ChildrenGeneric _ cs = cs 

type Interesting (ch :: Type) (a :: Type) (t :: Type) = Defined_list (Children ch t) (NoChildren ch t) (IsNothing (Interesting' ch a '[t] (Children ch t))) Source #

type family NoChildren (ch :: Type) (a :: Type) :: Constraint where ... Source #

Equations

NoChildren ch a = PrettyError '['Text "No type family instance for " :<>: QuoteType (Children ch a), 'Text "arising from a traversal over " :<>: QuoteType a, 'Text "with custom strategy " :<>: QuoteType ch] 

type family Interesting' (ch :: Type) (a :: Type) (seen :: [Type]) (ts :: [Type]) :: Maybe [Type] where ... Source #

Equations

Interesting' ch _ seen '[] = 'Just seen 
Interesting' ch a seen (t ': ts) = InterestingOr ch a (InterestingUnless ch a seen t (Elem t seen)) ts 

type family InterestingUnless (ch :: Type) (a :: Type) (seen :: [Type]) (t :: Type) (alreadySeen :: Bool) :: Maybe [Type] where ... Source #

Equations

InterestingUnless ch a seen a _ = 'Nothing 
InterestingUnless ch a seen t 'True = 'Just seen 
InterestingUnless ch a seen t 'False = Defined_list (Children ch t) (NoChildren ch t) (Interesting' ch a (t ': seen) (Children ch t)) 

type family InterestingOr (ch :: Type) (a :: Type) (seen' :: Maybe [Type]) (ts :: [Type]) :: Maybe [Type] where ... Source #

Equations

InterestingOr ch a 'Nothing _ = 'Nothing 
InterestingOr ch a ('Just seen) ts = Interesting' ch a seen ts 

type family Elem a as where ... Source #

Equations

Elem a (a ': _) = 'True 
Elem a (_ ': as) = Elem a as 
Elem a '[] = 'False 

type family IsNothing a where ... Source #

Equations

IsNothing ('Just _) = 'False 
IsNothing 'Nothing = 'True 

class HasTypes s a where Source #

Minimal complete definition

Nothing

Methods

types_ :: Traversal' s a Source #

Instances

Instances details
HasTypes s Void Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

types_ :: Traversal' s Void Source #

HasTypesUsing ChGeneric s s a a => HasTypes s a Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

types_ :: Traversal' s a Source #

HasTypes Void a Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

types_ :: Traversal' Void a Source #

data Void Source #

Instances

Instances details
HasTypes s Void Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

types_ :: Traversal' s Void Source #

HasTypes Void a Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

types_ :: Traversal' Void a Source #

HasTypesUsing ch s s Void Void Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal s s Void Void Source #

HasTypesUsing ch Void Void a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal Void Void a b Source #

class HasTypesUsing (ch :: Type) s t a b where Source #

Since: 1.2.0.0

Methods

typesUsing_ :: Traversal s t a b Source #

Instances

Instances details
HasTypesUsing ch a b a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal a b a b Source #

HasTypesOpt ch (Interesting ch a s) s t a b => HasTypesUsing ch s t a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal s t a b Source #

HasTypesUsing ch s s Void Void Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal s s Void Void Source #

HasTypesUsing ch Void Void a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesUsing_ :: Traversal Void Void a b Source #

class HasTypesCustom (ch :: Type) s t a b where Source #

By adding instances to this class, we can override the default behaviour in an ad-hoc manner. For example:

instance HasTypesCustom Custom Opaque Opaque String String where
  typesCustom f (Opaque str) = Opaque $ f str

Since: 1.2.0.0

Methods

typesCustom :: Traversal s t a b Source #

This function should never be used directly, only to override the default traversal behaviour. To actually use the custom traversal strategy, see typesUsing. This is because typesUsing does additional optimisations, like ensuring that nodes with no relevant members will not be traversed at runtime.

Instances

Instances details
(GHasTypes ch (Rep s) (Rep t) a b, Generic s, Generic t, Defined (Rep s) (PrettyError '['Text "No instance " :<>: QuoteType (HasTypesCustom ch s t a b)] :: Constraint) ()) => HasTypesCustom ch s t a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesCustom :: Traversal s t a b Source #

class HasTypesOpt (ch :: Type) (p :: Bool) s t a b where Source #

Methods

typesOpt :: Traversal s t a b Source #

Instances

Instances details
HasTypesOpt ch 'False s s a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesOpt :: Traversal s s a b Source #

HasTypesCustom ch s t a b => HasTypesOpt ch 'True s t a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

typesOpt :: Traversal s t a b Source #

class GHasTypes ch s t a b where Source #

Methods

gtypes_ :: Traversal (s x) (t x) a b Source #

Instances

Instances details
GHasTypes (ch :: k1) (V1 :: k2 -> Type) (V1 :: k2 -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k). Traversal (V1 x) (V1 x) a b Source #

GHasTypes (ch :: k1) (U1 :: k2 -> Type) (U1 :: k2 -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k). Traversal (U1 x) (U1 x) a b Source #

HasTypesUsing ch s t a b => GHasTypes (ch :: Type) (Rec0 s :: k -> Type) (Rec0 t :: k -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k0). Traversal (Rec0 s x) (Rec0 t x) a b Source #

(GHasTypes ch l l' a b, GHasTypes ch r r' a b) => GHasTypes (ch :: k1) (l :+: r :: k2 -> Type) (l' :+: r' :: k2 -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k). Traversal ((l :+: r) x) ((l' :+: r') x) a b Source #

(GHasTypes ch l l' a b, GHasTypes ch r r' a b) => GHasTypes (ch :: k1) (l :*: r :: k2 -> Type) (l' :*: r' :: k2 -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k). Traversal ((l :*: r) x) ((l' :*: r') x) a b Source #

GHasTypes ch s t a b => GHasTypes (ch :: k1) (M1 m meta s :: k2 -> Type) (M1 m meta t :: k2 -> Type) a b Source # 
Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k). Traversal (M1 m meta s x) (M1 m meta t x) a b Source #

HasTypes b a => GHasTypes ChGeneric (Rec0 b :: k -> Type) (Rec0 b :: k -> Type) a a Source #

The default instance for HasTypes acts as a synonym for 'HasTypesUsing ChGeneric', so in most cases this instance should behave the same as the one above. However, there might be overlapping instances defined for HasTypes directly, in which case we want to prefer those instances (even though the custom instances should always be added to HasTypesCustom)

Instance details

Defined in Data.Generics.Product.Internal.Types

Methods

gtypes_ :: forall (x :: k0). Traversal (Rec0 b x) (Rec0 b x) a a Source #