{-# LANGUAGE StaticPointers #-}

module Data.Profunctor.Static (StaticProfunctor(..)) where

import Control.Distributed.Closure
import Data.Typeable (Typeable)

-- | Instances of 'StaticProfunctor' should satisfy the following laws:
--
-- @
-- 'staticDimap' (static id) (static id) = static id
-- 'staticLmap' (static id) = static id
-- 'staticRmap' (static id) = static id
-- 'staticDimap' f g = staticLmap f . staticRmap g
-- @
class Typeable p => StaticProfunctor p where
  staticDimap
    :: (Typeable a, Typeable b, Typeable c, Typeable d)
    => Closure (a -> b) -> Closure (c -> d) -> p b c -> p a d
  staticDimap Closure (a -> b)
sf Closure (c -> d)
sg = forall (p :: * -> * -> *) a b c.
(StaticProfunctor p, Typeable a, Typeable b, Typeable c) =>
Closure (a -> b) -> p b c -> p a c
staticLmap Closure (a -> b)
sf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a c d.
(StaticProfunctor p, Typeable a, Typeable c, Typeable d) =>
Closure (c -> d) -> p a c -> p a d
staticRmap Closure (c -> d)
sg

  staticLmap
    :: (Typeable a, Typeable b, Typeable c)
    => Closure (a -> b) -> p b c -> p a c
  staticLmap Closure (a -> b)
sf = forall (p :: * -> * -> *) a b c d.
(StaticProfunctor p, Typeable a, Typeable b, Typeable c,
 Typeable d) =>
Closure (a -> b) -> Closure (c -> d) -> p b c -> p a d
staticDimap Closure (a -> b)
sf (static forall a. a -> a
id)

  staticRmap
    :: (Typeable a, Typeable c, Typeable d)
    => Closure (c -> d) -> p a c -> p a d
  staticRmap Closure (c -> d)
sg = forall (p :: * -> * -> *) a b c d.
(StaticProfunctor p, Typeable a, Typeable b, Typeable c,
 Typeable d) =>
Closure (a -> b) -> Closure (c -> d) -> p b c -> p a d
staticDimap (static forall a. a -> a
id) Closure (c -> d)
sg

  {-# MINIMAL staticDimap | staticLmap, staticRmap #-}

staticCompose
  :: (Typeable a, Typeable b, Typeable c)
  => Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
staticCompose :: forall a b c.
(Typeable a, Typeable b, Typeable c) =>
Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
staticCompose Closure (b -> c)
f Closure (a -> b)
g = static forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (b -> c)
f forall a b.
Typeable a =>
Closure (a -> b) -> Closure a -> Closure b
`cap` Closure (a -> b)
g

instance StaticProfunctor WrappedArrowClosure where
  staticDimap :: forall a b c d.
(Typeable a, Typeable b, Typeable c, Typeable d) =>
Closure (a -> b)
-> Closure (c -> d)
-> WrappedArrowClosure b c
-> WrappedArrowClosure a d
staticDimap Closure (a -> b)
sf Closure (c -> d)
sg (WrapArrowClosure Closure (b -> c)
sk) =
    forall a b. Closure (a -> b) -> WrappedArrowClosure a b
WrapArrowClosure (Closure (c -> d)
sg forall a b c.
(Typeable a, Typeable b, Typeable c) =>
Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
`staticCompose` Closure (b -> c)
sk forall a b c.
(Typeable a, Typeable b, Typeable c) =>
Closure (b -> c) -> Closure (a -> b) -> Closure (a -> c)
`staticCompose` Closure (a -> b)
sf)