{-# LANGUAGE PackageImports #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generics.Product.Param
( Rec (Rec)
, HasParam (..)
, Param (..)
) where
import "generic-lens-core" Data.Generics.Internal.VL.Traversal
import qualified "generic-lens-core" Data.Generics.Product.Internal.Param as Core
import "generic-lens-core" Data.Generics.Internal.GenericN
import "generic-lens-core" Data.Generics.Internal.Void
import GHC.TypeLits
class HasParam (p :: Nat) s t a b | p t a -> s, p s b -> t, p s -> a, p t -> b where
param :: Traversal s t a b
instance Core.Context n s t a b => HasParam n s t a b where
param :: (a -> f b) -> s -> f t
param = Traversal s t a b -> (a -> f b) -> s -> f t
forall (f :: * -> *) s t a b.
Applicative f =>
Traversal s t a b -> (a -> f b) -> s -> f t
confusing (forall s t a b. Context n s t a b => Traversal s t a b
forall (n :: Nat) s t a b. Context n s t a b => Traversal s t a b
Core.derived @n)
{-# INLINE param #-}
instance {-# OVERLAPPING #-} HasParam p (Void1 a) (Void1 b) a b where
param :: (a -> f b) -> Void1 a -> f (Void1 b)
param = (a -> f b) -> Void1 a -> f (Void1 b)
forall a. HasCallStack => a
undefined