{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fenable-rewrite-rules #-}
----------------------------------------------------------------------
-- |
-- Copyright   :  (c) Edward Kmett 2011-2014
-- License     :  BSD3
--
-- Maintainer  :  [email protected]
-- Stability   :  experimental
--
-- Representable contravariant endofunctors over the category of Haskell
-- types are isomorphic to @(_ -> r)@ and resemble mappings to a
-- fixed range.
----------------------------------------------------------------------
module Data.Functor.Contravariant.Rep
  (
  -- * Representable Contravariant Functors
    Representable(..)
  , tabulated
  -- * Default definitions
  , contramapRep
  ) where

import Data.Functor.Contravariant
import Data.Functor.Product
import Data.Profunctor
import Data.Proxy
import GHC.Generics hiding (Rep)
import Prelude hiding (lookup)

-- | A 'Contravariant' functor @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(_ -> Rep f)@.
--
-- @
-- 'tabulate' . 'index' ≡ id
-- 'index' . 'tabulate' ≡ id
-- @
class Contravariant f => Representable f where
  type Rep f :: *
  -- |
  -- @
  -- 'contramap' f ('tabulate' g) = 'tabulate' (g . f)
  -- @
  tabulate :: (a -> Rep f) -> f a

  index    :: f a -> a -> Rep f

  -- |
  -- @
  -- 'contramapWithRep' f p ≡ 'tabulate' $ 'either' ('index' p) 'id' . f
  -- @
  contramapWithRep :: (b -> Either a (Rep f)) -> f a -> f b
  contramapWithRep b -> Either a (Rep f)
f f a
p = forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
p) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep f)
f

{-# RULES
"tabulate/index" forall t. tabulate (index t) = t #-}

-- | 'tabulate' and 'index' form two halves of an isomorphism.
--
-- This can be used with the combinators from the @lens@ package.
--
-- @'tabulated' :: 'Representable' f => 'Iso'' (a -> 'Rep' f) (f a)@
tabulated :: (Representable f, Representable g, Profunctor p, Functor h)
          => p (f a) (h (g b)) -> p (a -> Rep f) (h (b -> Rep g))
tabulated :: forall (f :: * -> *) (g :: * -> *) (p :: * -> * -> *) (h :: * -> *)
       a b.
(Representable f, Representable g, Profunctor p, Functor h) =>
p (f a) (h (g b)) -> p (a -> Rep f) (h (b -> Rep g))
tabulated = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index)
{-# INLINE tabulated #-}

contramapRep :: Representable f => (a -> b) -> f b -> f a
contramapRep :: forall (f :: * -> *) a b. Representable f => (a -> b) -> f b -> f a
contramapRep a -> b
f = forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index

instance Representable Proxy where
  type Rep Proxy = ()
  tabulate :: forall a. (a -> Rep Proxy) -> Proxy a
tabulate a -> Rep Proxy
_ = forall {k} (t :: k). Proxy t
Proxy
  index :: forall a. Proxy a -> a -> Rep Proxy
index Proxy a
Proxy a
_ = ()
  contramapWithRep :: forall b a. (b -> Either a (Rep Proxy)) -> Proxy a -> Proxy b
contramapWithRep b -> Either a (Rep Proxy)
_ Proxy a
Proxy = forall {k} (t :: k). Proxy t
Proxy

instance Representable (Op r) where
  type Rep (Op r) = r
  tabulate :: forall a. (a -> Rep (Op r)) -> Op r a
tabulate = forall a b. (b -> a) -> Op a b
Op
  index :: forall a. Op r a -> a -> Rep (Op r)
index = forall a b. Op a b -> b -> a
getOp

instance Representable Predicate where
  type Rep Predicate = Bool
  tabulate :: forall a. (a -> Rep Predicate) -> Predicate a
tabulate = forall a. (a -> Bool) -> Predicate a
Predicate
  index :: forall a. Predicate a -> a -> Rep Predicate
index = forall a. Predicate a -> a -> Bool
getPredicate

instance (Representable f, Representable g) => Representable (Product f g) where
  type Rep (Product f g) = (Rep f, Rep g)
  tabulate :: forall a. (a -> Rep (Product f g)) -> Product f g a
tabulate a -> Rep (Product f g)
f = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep (Product f g)
f)) (forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep (Product f g)
f))
  index :: forall a. Product f g a -> a -> Rep (Product f g)
index (Pair f a
f g a
g) a
a = (forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
f a
a, forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index g a
g a
a)
  contramapWithRep :: forall b a.
(b -> Either a (Rep (Product f g)))
-> Product f g a -> Product f g b
contramapWithRep b -> Either a (Rep (Product f g))
h (Pair f a
f g a
g) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair
      (forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep (Product f g))
h) f a
f)
      (forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep (Product f g))
h) g a
g)

instance Representable U1 where
  type Rep U1 = ()
  tabulate :: forall a. (a -> Rep U1) -> U1 a
tabulate a -> Rep U1
_ = forall k (p :: k). U1 p
U1
  index :: forall a. U1 a -> a -> Rep U1
index U1 a
U1 a
_ = ()
  contramapWithRep :: forall b a. (b -> Either a (Rep U1)) -> U1 a -> U1 b
contramapWithRep b -> Either a (Rep U1)
_ U1 a
U1 = forall k (p :: k). U1 p
U1

instance (Representable f, Representable g) => Representable (f :*: g) where
  type Rep (f :*: g) = (Rep f, Rep g)
  tabulate :: forall a. (a -> Rep (f :*: g)) -> (:*:) f g a
tabulate a -> Rep (f :*: g)
f = forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep (f :*: g)
f) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep (f :*: g)
f)
  index :: forall a. (:*:) f g a -> a -> Rep (f :*: g)
index (f a
f :*: g a
g) a
a = (forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
f a
a, forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index g a
g a
a)
  contramapWithRep :: forall b a.
(b -> Either a (Rep (f :*: g))) -> (:*:) f g a -> (:*:) f g b
contramapWithRep b -> Either a (Rep (f :*: g))
h (f a
f :*: g a
g) =
    forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep (f :*: g))
h) f a
f forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep (f :*: g))
h) g a
g