{-# 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