{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generics.Sum.Subtype
(
AsSubtype (..)
) where
import Data.Generics.Internal.Void
import Data.Generics.Sum.Internal.Subtype
import GHC.Generics (Generic (Rep))
import Data.Generics.Internal.VL.Prism
import Data.Generics.Internal.Profunctor.Iso
class AsSubtype sub sup where
_Sub :: Prism' sup sub
_Sub = (sub -> sup) -> (sup -> Either sup sub) -> Prism sup sup sub sub
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism sub -> sup
forall sub sup. AsSubtype sub sup => sub -> sup
injectSub (\i :: sup
i -> Either sup sub
-> (sub -> Either sup sub) -> Maybe sub -> Either sup sub
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (sup -> Either sup sub
forall a b. a -> Either a b
Left sup
i) sub -> Either sup sub
forall a b. b -> Either a b
Right (sup -> Maybe sub
forall sub sup. AsSubtype sub sup => sup -> Maybe sub
projectSub sup
i))
{-# INLINE[2] _Sub #-}
injectSub :: sub -> sup
injectSub
= (Tagged sub (Identity sub) -> Tagged sup (Identity sup))
-> sub -> sup
forall b t.
(Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
build (AsSubtype sub sup => Prism sup sup sub sub
forall sub sup. AsSubtype sub sup => Prism sup sup sub sub
_Sub @sub @sup)
projectSub :: sup -> Maybe sub
projectSub
= (sup -> Maybe sub)
-> (sub -> Maybe sub) -> Either sup sub -> Maybe sub
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe sub -> sup -> Maybe sub
forall a b. a -> b -> a
const Maybe sub
forall a. Maybe a
Nothing) sub -> Maybe sub
forall a. a -> Maybe a
Just (Either sup sub -> Maybe sub)
-> (sup -> Either sup sub) -> sup -> Maybe sub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism sup sup sub sub -> sup -> Either sup sub
forall s t a b. Prism s t a b -> s -> Either t a
match (AsSubtype sub sup => Prism sup sup sub sub
forall sub sup. AsSubtype sub sup => Prism sup sup sub sub
_Sub @sub @sup)
{-# MINIMAL (injectSub, projectSub) | _Sub #-}
instance
( Generic sub
, Generic sup
, GAsSubtype (Rep sub) (Rep sup)
) => AsSubtype sub sup where
_Sub :: p sub (f sub) -> p sup (f sup)
_Sub f :: p sub (f sub)
f = (Market sub sub sub sub -> Market sub sub sup sup)
-> p sub (f sub) -> p sup (f sup)
forall a b s t. (Market a b a b -> Market a b s t) -> Prism s t a b
prismRavel (Market sub sub (Rep sup Any) (Rep sup Any)
-> Market sub sub sup sup
forall a b x. (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso (Market sub sub (Rep sup Any) (Rep sup Any)
-> Market sub sub sup sup)
-> (Market sub sub sub sub
-> Market sub sub (Rep sup Any) (Rep sup Any))
-> Market sub sub sub sub
-> Market sub sub sup sup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Market sub sub (Rep sub Any) (Rep sub Any)
-> Market sub sub (Rep sup Any) (Rep sup Any)
forall (subf :: * -> *) (supf :: * -> *) x.
GAsSubtype subf supf =>
Prism' (supf x) (subf x)
_GSub (Market sub sub (Rep sub Any) (Rep sub Any)
-> Market sub sub (Rep sup Any) (Rep sup Any))
-> (Market sub sub sub sub
-> Market sub sub (Rep sub Any) (Rep sub Any))
-> Market sub sub sub sub
-> Market sub sub (Rep sup Any) (Rep sup Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso sub sub (Rep sub Any) (Rep sub Any)
-> Iso (Rep sub Any) (Rep sub Any) sub sub
forall s t a b. Iso s t a b -> Iso b a t s
fromIso forall a b x. (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
Iso sub sub (Rep sub Any) (Rep sub Any)
repIso) p sub (f sub)
f
{-# INLINE[2] _Sub #-}
instance {-# OVERLAPPING #-} AsSubtype a a where
_Sub :: p a (f a) -> p a (f a)
_Sub = p a (f a) -> p a (f a)
forall a. a -> a
id
{-# INLINE[2] _Sub #-}
#if __GLASGOW_HASKELL__ < 804
#else
#endif
instance {-# OVERLAPPING #-} AsSubtype a Void where
injectSub :: a -> Void
injectSub = a -> Void
forall a. HasCallStack => a
undefined
projectSub :: Void -> Maybe a
projectSub = Void -> Maybe a
forall a. HasCallStack => a
undefined
#if __GLASGOW_HASKELL__ < 804
#else
#endif
instance {-# OVERLAPPING #-} AsSubtype Void a where
injectSub :: Void -> a
injectSub = Void -> a
forall a. HasCallStack => a
undefined
projectSub :: a -> Maybe Void
projectSub = a -> Maybe Void
forall a. HasCallStack => a
undefined