{-# LANGUAGE PackageImports #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generics.Product.HList
( IsList (..)
) where
import "this" Data.Generics.Internal.VL.Iso (Iso, iso2isovl)
import "generic-lens-core" Data.Generics.Internal.Profunctor.Iso (repIso)
import qualified "generic-lens-core" Data.Generics.Product.Internal.HList as Core
import Data.Kind
import GHC.Generics
class IsList
(f :: Type)
(g :: Type)
(as :: [Type])
(bs :: [Type]) | f -> as, g -> bs where
list :: Iso f g (Core.HList as) (Core.HList bs)
instance
( Generic f
, Generic g
, Core.GIsList (Rep f) (Rep g) as bs
) => IsList f g as bs where
list :: p (HList as) (f (HList bs)) -> p f (f g)
list = Iso f g (HList as) (HList bs) -> Iso f g (HList as) (HList bs)
forall s t a b. Iso s t a b -> Iso s t a b
iso2isovl (p i (Rep f Any) (Rep g Any) -> p i f g
forall a b x. (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso (p i (Rep f Any) (Rep g Any) -> p i f g)
-> (p i (HList as) (HList bs) -> p i (Rep f Any) (Rep g Any))
-> p i (HList as) (HList bs)
-> p i f g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (HList as) (HList bs) -> p i (Rep f Any) (Rep g Any)
forall (f :: * -> *) (g :: * -> *) (as :: [*]) (bs :: [*]) x.
GIsList f g as bs =>
Iso (f x) (g x) (HList as) (HList bs)
Core.glist)
{-# INLINE list #-}