{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fenable-rewrite-rules #-}
----------------------------------------------------------------------
-- |
-- Copyright   :  (c) Edward Kmett 2011-2014
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- 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 = (b -> Rep f) -> f b
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((b -> Rep f) -> f b) -> (b -> Rep f) -> f b
forall a b. (a -> b) -> a -> b
$ (a -> Rep f) -> (Rep f -> Rep f) -> Either a (Rep f) -> Rep f
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (f a -> a -> Rep f
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
p) Rep f -> Rep f
forall a. a -> a
id (Either a (Rep f) -> Rep f)
-> (b -> Either a (Rep f)) -> b -> Rep f
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 :: p (f a) (h (g b)) -> p (a -> Rep f) (h (b -> Rep g))
tabulated = ((a -> Rep f) -> f a)
-> (h (g b) -> h (b -> Rep g))
-> p (f a) (h (g b))
-> p (a -> Rep f) (h (b -> Rep g))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (a -> Rep f) -> f a
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((g b -> b -> Rep g) -> h (g b) -> h (b -> Rep g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g b -> b -> Rep g
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index)
{-# INLINE tabulated #-}

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

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

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

instance Representable Predicate where
  type Rep Predicate = Bool
  tabulate :: (a -> Rep Predicate) -> Predicate a
tabulate = (a -> Rep Predicate) -> Predicate a
forall a. (a -> Bool) -> Predicate a
Predicate
  index :: Predicate a -> a -> Rep Predicate
index = Predicate a -> a -> Rep Predicate
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 :: (a -> Rep (Product f g)) -> Product f g a
tabulate a -> Rep (Product f g)
f = f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair ((a -> Rep f) -> f a
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((Rep f, Rep g) -> Rep f
forall a b. (a, b) -> a
fst ((Rep f, Rep g) -> Rep f) -> (a -> (Rep f, Rep g)) -> a -> Rep f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Rep f, Rep g)
a -> Rep (Product f g)
f)) ((a -> Rep g) -> g a
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((Rep f, Rep g) -> Rep g
forall a b. (a, b) -> b
snd ((Rep f, Rep g) -> Rep g) -> (a -> (Rep f, Rep g)) -> a -> Rep g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Rep f, Rep g)
a -> Rep (Product f g)
f))
  index :: Product f g a -> a -> Rep (Product f g)
index (Pair f a
f g a
g) a
a = (f a -> a -> Rep f
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
f a
a, g a -> a -> Rep g
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index g a
g a
a)
  contramapWithRep :: (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) = f b -> g b -> Product f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair
      ((b -> Either a (Rep f)) -> f a -> f b
forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (((Rep f, Rep g) -> Rep f)
-> Either a (Rep f, Rep g) -> Either a (Rep f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep f, Rep g) -> Rep f
forall a b. (a, b) -> a
fst (Either a (Rep f, Rep g) -> Either a (Rep f))
-> (b -> Either a (Rep f, Rep g)) -> b -> Either a (Rep f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep f, Rep g)
b -> Either a (Rep (Product f g))
h) f a
f)
      ((b -> Either a (Rep g)) -> g a -> g b
forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (((Rep f, Rep g) -> Rep g)
-> Either a (Rep f, Rep g) -> Either a (Rep g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep f, Rep g) -> Rep g
forall a b. (a, b) -> b
snd (Either a (Rep f, Rep g) -> Either a (Rep g))
-> (b -> Either a (Rep f, Rep g)) -> b -> Either a (Rep g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep f, Rep g)
b -> Either a (Rep (Product f g))
h) g a
g)

instance Representable U1 where
  type Rep U1 = ()
  tabulate :: (a -> Rep U1) -> U1 a
tabulate a -> Rep U1
_ = U1 a
forall k (p :: k). U1 p
U1
  index :: U1 a -> a -> Rep U1
index U1 a
U1 a
_ = ()
  contramapWithRep :: (b -> Either a (Rep U1)) -> U1 a -> U1 b
contramapWithRep b -> Either a (Rep U1)
_ U1 a
U1 = U1 b
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 :: (a -> Rep (f :*: g)) -> (:*:) f g a
tabulate a -> Rep (f :*: g)
f = (a -> Rep f) -> f a
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((Rep f, Rep g) -> Rep f
forall a b. (a, b) -> a
fst ((Rep f, Rep g) -> Rep f) -> (a -> (Rep f, Rep g)) -> a -> Rep f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Rep f, Rep g)
a -> Rep (f :*: g)
f) f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> Rep g) -> g a
forall (f :: * -> *) a. Representable f => (a -> Rep f) -> f a
tabulate ((Rep f, Rep g) -> Rep g
forall a b. (a, b) -> b
snd ((Rep f, Rep g) -> Rep g) -> (a -> (Rep f, Rep g)) -> a -> Rep g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Rep f, Rep g)
a -> Rep (f :*: g)
f)
  index :: (:*:) f g a -> a -> Rep (f :*: g)
index (f a
f :*: g a
g) a
a = (f a -> a -> Rep f
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index f a
f a
a, g a -> a -> Rep g
forall (f :: * -> *) a. Representable f => f a -> a -> Rep f
index g a
g a
a)
  contramapWithRep :: (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) =
    (b -> Either a (Rep f)) -> f a -> f b
forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (((Rep f, Rep g) -> Rep f)
-> Either a (Rep f, Rep g) -> Either a (Rep f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep f, Rep g) -> Rep f
forall a b. (a, b) -> a
fst (Either a (Rep f, Rep g) -> Either a (Rep f))
-> (b -> Either a (Rep f, Rep g)) -> b -> Either a (Rep f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep f, Rep g)
b -> Either a (Rep (f :*: g))
h) f a
f f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (b -> Either a (Rep g)) -> g a -> g b
forall (f :: * -> *) b a.
Representable f =>
(b -> Either a (Rep f)) -> f a -> f b
contramapWithRep (((Rep f, Rep g) -> Rep g)
-> Either a (Rep f, Rep g) -> Either a (Rep g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep f, Rep g) -> Rep g
forall a b. (a, b) -> b
snd (Either a (Rep f, Rep g) -> Either a (Rep g))
-> (b -> Either a (Rep f, Rep g)) -> b -> Either a (Rep g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a (Rep f, Rep g)
b -> Either a (Rep (f :*: g))
h) g a
g