module Network.GRPC.Spec.Util.HKD (
HKD
, DecoratedWith
, Undecorated
, Coerce(..)
, Traversable(..)
, sequence
, map
, ValidDecoration
, pure
, Checked
, sequenceChecked
) where
import Prelude hiding (Traversable(..), pure, map)
import Prelude qualified
import Control.Monad.Except (MonadError, throwError)
import Data.Functor.Identity
import Data.Kind
import Data.Proxy
import Unsafe.Coerce (unsafeCoerce)
data Undecorated (x :: Type)
data DecoratedWith (f :: Type -> Type) (x :: Type)
type family HKD (f :: Type -> Type) (x :: Type) :: Type
type instance HKD Undecorated x = x
type instance HKD (DecoratedWith f) x = f x
class Coerce t where
undecorate :: t (DecoratedWith Identity) -> t Undecorated
undecorate = t (DecoratedWith Identity) -> t Undecorated
forall a b. a -> b
unsafeCoerce
decorate :: t Undecorated -> t (DecoratedWith Identity)
decorate = t Undecorated -> t (DecoratedWith Identity)
forall a b. a -> b
unsafeCoerce
class Coerce t => Traversable t where
traverse ::
Applicative m
=> (forall a. f a -> m (g a))
-> t (DecoratedWith f)
-> m (t (DecoratedWith g))
sequence ::
(Traversable t, Applicative m)
=> t (DecoratedWith m) -> m (t Undecorated)
sequence :: forall (t :: (* -> *) -> *) (m :: * -> *).
(Traversable t, Applicative m) =>
t (DecoratedWith m) -> m (t Undecorated)
sequence = (t (DecoratedWith Identity) -> t Undecorated)
-> m (t (DecoratedWith Identity)) -> m (t Undecorated)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (DecoratedWith Identity) -> t Undecorated
forall (t :: (* -> *) -> *).
Coerce t =>
t (DecoratedWith Identity) -> t Undecorated
undecorate (m (t (DecoratedWith Identity)) -> m (t Undecorated))
-> (t (DecoratedWith m) -> m (t (DecoratedWith Identity)))
-> t (DecoratedWith m)
-> m (t Undecorated)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> m (Identity a))
-> t (DecoratedWith m) -> m (t (DecoratedWith Identity))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a))
-> t (DecoratedWith f) -> m (t (DecoratedWith g))
forall (t :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *).
(Traversable t, Applicative m) =>
(forall a. f a -> m (g a))
-> t (DecoratedWith f) -> m (t (DecoratedWith g))
traverse ((a -> Identity a) -> m a -> m (Identity a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity)
map ::
Traversable t
=> (forall a. f a -> g a)
-> t (DecoratedWith f)
-> t (DecoratedWith g)
map :: forall (t :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Traversable t =>
(forall a. f a -> g a)
-> t (DecoratedWith f) -> t (DecoratedWith g)
map forall a. f a -> g a
f = Identity (t (DecoratedWith g)) -> t (DecoratedWith g)
forall a. Identity a -> a
runIdentity (Identity (t (DecoratedWith g)) -> t (DecoratedWith g))
-> (t (DecoratedWith f) -> Identity (t (DecoratedWith g)))
-> t (DecoratedWith f)
-> t (DecoratedWith g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> Identity (g a))
-> t (DecoratedWith f) -> Identity (t (DecoratedWith g))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative m =>
(forall a. f a -> m (g a))
-> t (DecoratedWith f) -> m (t (DecoratedWith g))
forall (t :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *).
(Traversable t, Applicative m) =>
(forall a. f a -> m (g a))
-> t (DecoratedWith f) -> m (t (DecoratedWith g))
traverse (g a -> Identity (g a)
forall a. a -> Identity a
Identity (g a -> Identity (g a)) -> (f a -> g a) -> f a -> Identity (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> g a
forall a. f a -> g a
f)
data IsValidDecoration (c :: (Type -> Type) -> Constraint) f where
ValidUndecorated :: IsValidDecoration c Undecorated
ValidDecoratedWith :: c f => IsValidDecoration c (DecoratedWith f)
class ValidDecoration (c :: (Type -> Type) -> Constraint) f where
validDecoration :: IsValidDecoration c f
validDecoration = IsValidDecoration c f
forall a. HasCallStack => a
undefined
instance ValidDecoration c Undecorated where
validDecoration :: IsValidDecoration c Undecorated
validDecoration = IsValidDecoration c Undecorated
forall (c :: (* -> *) -> Constraint).
IsValidDecoration c Undecorated
ValidUndecorated
instance c f => ValidDecoration c (DecoratedWith f) where
validDecoration :: IsValidDecoration c (DecoratedWith f)
validDecoration = IsValidDecoration c (DecoratedWith f)
forall (c :: (* -> *) -> Constraint) (f :: * -> *).
c f =>
IsValidDecoration c (DecoratedWith f)
ValidDecoratedWith
pure :: forall f a. ValidDecoration Applicative f => Proxy f -> a -> HKD f a
pure :: forall (f :: * -> *) a.
ValidDecoration Applicative f =>
Proxy f -> a -> HKD f a
pure Proxy f
_ =
case IsValidDecoration Applicative f
forall (c :: (* -> *) -> Constraint) (f :: * -> *).
ValidDecoration c f =>
IsValidDecoration c f
validDecoration :: IsValidDecoration Applicative f of
IsValidDecoration Applicative f
ValidDecoratedWith -> a -> f a
a -> HKD f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
IsValidDecoration Applicative f
ValidUndecorated -> a -> a
a -> HKD f a
forall a. a -> a
id
type Checked e = DecoratedWith (Either e)
sequenceChecked ::
(MonadError e m, Traversable t)
=> t (Checked e) -> m (t Undecorated)
sequenceChecked :: forall e (m :: * -> *) (t :: (* -> *) -> *).
(MonadError e m, Traversable t) =>
t (Checked e) -> m (t Undecorated)
sequenceChecked = (e -> m (t Undecorated))
-> (t Undecorated -> m (t Undecorated))
-> Either e (t Undecorated)
-> m (t Undecorated)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m (t Undecorated)
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError t Undecorated -> m (t Undecorated)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e (t Undecorated) -> m (t Undecorated))
-> (t (Checked e) -> Either e (t Undecorated))
-> t (Checked e)
-> m (t Undecorated)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Checked e) -> Either e (t Undecorated)
forall (t :: (* -> *) -> *) (m :: * -> *).
(Traversable t, Applicative m) =>
t (DecoratedWith m) -> m (t Undecorated)
sequence