{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Data.Generics.Wrapped
( Wrapped (..)
, wrappedTo
, wrappedFrom
, _Unwrapped
, _Wrapped
)
where
import Control.Applicative (Const(..))
import Data.Generics.Internal.Profunctor.Iso
import qualified Data.Generics.Internal.VL.Iso as VL
import Data.Generics.Internal.Families.Changing ( UnifyHead )
import Data.Kind (Constraint)
import GHC.Generics
import GHC.TypeLits
type family ErrorUnlessOnlyOne a b :: Constraint where
ErrorUnlessOnlyOne t (M1 i k a) = ErrorUnlessOnlyOne t a
ErrorUnlessOnlyOne t (K1 i a) = ()
ErrorUnlessOnlyOne t a =
TypeError ('ShowType t ':<>: 'Text " is not a single-constructor, single-field datatype")
_Unwrapped :: Wrapped s t a b => VL.Iso s t a b
_Unwrapped :: Iso s t a b
_Unwrapped = p a (f b) -> p s (f t)
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso
{-# inline _Unwrapped #-}
_Wrapped :: Wrapped s t a b => VL.Iso b a t s
_Wrapped :: Iso b a t s
_Wrapped = Iso s t a b -> Iso b a t s
forall s t a b. Iso s t a b -> Iso b a t s
VL.fromIso forall s t a b. Wrapped s t a b => Iso s t a b
Iso s t a b
wrappedIso
{-# inline _Wrapped #-}
class GWrapped s t a b | s -> a, t -> b, s b -> t, t a -> s where
gWrapped :: Iso (s x) (t x) a b
instance GWrapped s t a b => GWrapped (M1 i k s) (M1 i k t) a b where
gWrapped :: p a b -> p (M1 i k s x) (M1 i k t x)
gWrapped = p (s x) (t x) -> p (M1 i k s x) (M1 i k t x)
forall i (c :: Meta) (f :: * -> *) p (g :: * -> *).
Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
mIso (p (s x) (t x) -> p (M1 i k s x) (M1 i k t x))
-> (p a b -> p (s x) (t x)) -> p a b -> p (M1 i k s x) (M1 i k t x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (s x) (t x)
forall (s :: * -> *) (t :: * -> *) a b x.
GWrapped s t a b =>
Iso (s x) (t x) a b
gWrapped
instance (a ~ c, b ~ d) => GWrapped (K1 i a) (K1 i b) c d where
gWrapped :: p c d -> p (K1 i a x) (K1 i b x)
gWrapped = p c d -> p (K1 i a x) (K1 i b x)
forall r a p b. Iso (K1 r a p) (K1 r b p) a b
kIso
class Wrapped s t a b | s -> a, t -> b where
wrappedIso :: VL.Iso s t a b
wrappedTo :: forall s t a b. Wrapped s t a b => s -> a
wrappedTo :: s -> a
wrappedTo a :: s
a = ((a -> Const a b) -> s -> Const a t) -> s -> a
forall a b t a b. ((a -> Const a b) -> t -> Const a b) -> t -> a
view (Wrapped s t a b => Iso s t a b
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso @s @t @a @b) s
a
where view :: ((a -> Const a b) -> t -> Const a b) -> t -> a
view l :: (a -> Const a b) -> t -> Const a b
l s :: t
s = Const a b -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
l a -> Const a b
forall k a (b :: k). a -> Const a b
Const t
s)
{-# INLINE wrappedTo #-}
wrappedFrom :: forall s t a b. Wrapped s t a b => b -> t
wrappedFrom :: b -> t
wrappedFrom a :: b
a = ((t -> Const t s) -> b -> Const t a) -> b -> t
forall a b t a b. ((a -> Const a b) -> t -> Const a b) -> t -> a
view (Iso s t a b -> Iso b a t s
forall s t a b. Iso s t a b -> Iso b a t s
VL.fromIso (Wrapped s t a b => Iso s t a b
forall s t a b. Wrapped s t a b => Iso s t a b
wrappedIso @s @t @a @b)) b
a
where view :: ((a -> Const a b) -> t -> Const a b) -> t -> a
view l :: (a -> Const a b) -> t -> Const a b
l s :: t
s = Const a b -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
l a -> Const a b
forall k a (b :: k). a -> Const a b
Const t
s)
{-# INLINE wrappedFrom #-}
instance
( Generic s
, Generic t
, GWrapped (Rep s) (Rep t) a b
, UnifyHead s t
, UnifyHead t s
) => Wrapped s t a b where
wrappedIso :: p a (f b) -> p s (f t)
wrappedIso = Iso s t a b -> Iso s t a b
forall s t a b. Iso s t a b -> Iso s t a b
iso2isovl (p (Rep s Any) (Rep t Any) -> p s t
forall a b x. (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso (p (Rep s Any) (Rep t Any) -> p s t)
-> (p a b -> p (Rep s Any) (Rep t Any)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Rep s Any) (Rep t Any)
forall (s :: * -> *) (t :: * -> *) a b x.
GWrapped s t a b =>
Iso (s x) (t x) a b
gWrapped)
{-# INLINE wrappedIso #-}