{-# LANGUAGE StaticPointers #-} module Data.Profunctor.Choice.Static where import Control.Distributed.Closure import Data.Bifunctor (bimap) import Data.Profunctor.Static import Data.Typeable (Typeable) class StaticProfunctor p => StaticChoice p where staticLeft' :: (Typeable a, Typeable b, Typeable c) => p a b -> p (Either a c) (Either b c) staticRight' :: (Typeable a, Typeable b, Typeable c) => p a b -> p (Either c a) (Either c b) instance StaticChoice WrappedArrowClosure where staticLeft' :: forall a b c. (Typeable a, Typeable b, Typeable c) => WrappedArrowClosure a b -> WrappedArrowClosure (Either a c) (Either b c) staticLeft' (WrapArrowClosure Closure (a -> b) sf) = forall a b. Closure (a -> b) -> WrappedArrowClosure a b WrapArrowClosure forall a b. (a -> b) -> a -> b $ static (\a -> b f -> forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap a -> b f forall a. a -> a id) forall a b. Typeable a => Closure (a -> b) -> Closure a -> Closure b `cap` Closure (a -> b) sf staticRight' :: forall a b c. (Typeable a, Typeable b, Typeable c) => WrappedArrowClosure a b -> WrappedArrowClosure (Either c a) (Either c b) staticRight' (WrapArrowClosure Closure (a -> b) sg) = forall a b. Closure (a -> b) -> WrappedArrowClosure a b WrapArrowClosure forall a b. (a -> b) -> a -> b $ static (\a -> b g -> forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap forall a. a -> a id a -> b g) forall a b. Typeable a => Closure (a -> b) -> Closure a -> Closure b `cap` Closure (a -> b) sg