-- |
-- This provides a subset of the functionality as the invariant package's "Data.Functor.Invariant" module, but based on "Data.Invertible", without all the instances, and with an interface matching "Data.Functor".
--
-- This module is intended to be imported qualified, e.g.,:
-- 
-- > import qualified Control.Invertible.Functor as Inv
--
{-# LANGUAGE CPP, TypeOperators, FlexibleInstances #-}
#if !(defined(VERSION_semigroupoids) && MIN_VERSION_semigroupoids(5,2,2))
{-# LANGUAGE Safe #-}
#endif
module Control.Invertible.Functor
  ( Functor(..)
  , fmapDefault
  , (<$>)
  ) where

import qualified Prelude
import Prelude hiding ((.), Functor(..), (<$>))
import Control.Arrow (Arrow)
import Control.Category ((.))
import Data.Monoid (Endo(..))

#ifdef VERSION_semigroupoids
import Data.Semigroupoid (Semigroupoid)
#endif
import Control.Invertible.BiArrow ((^^<<), invert)
import Data.Invertible.Bijection
import Data.Invertible.Monoid (BiEndo(..))

-- |An invariant version of 'Data.Functor.Functor', equivalent to 'Data.Functor.Inviarant.Invariant'.
class Functor f where
  fmap :: a <-> b -> f a -> f b

-- |Default invertible 'Functor' implementation for simple non-invertible 'Prelude.Functor's.
fmapDefault :: Prelude.Functor f => a <-> b -> f a -> f b
fmapDefault :: forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
fmapDefault (a -> b
f :<->: b -> a
_) f a
x = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> f a
x

-- |An infix synnonym for 'fmap'.
(<$>) :: Functor f => a <-> b -> f a -> f b
<$> :: forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
(<$>) = (a <-> b) -> f a -> f b
forall a b. (a <-> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
fmap
infixl 4 <$>

instance (
#ifdef VERSION_semigroupoids
    Semigroupoid a,
#endif
    Arrow a) => Functor (Bijection a b) where
  fmap :: forall a b. (a <-> b) -> Bijection a b a -> Bijection a b b
fmap = (a <-> b) -> Bijection a b a -> Bijection a b b
forall (a :: * -> * -> *) c d b.
BiArrow a =>
(c <-> d) -> a b c -> a b d
(^^<<)

instance Functor Endo where
  fmap :: forall a b. (a <-> b) -> Endo a -> Endo b
fmap (a -> b
f :<->: b -> a
g) (Endo a -> a
a) = (b -> b) -> Endo b
forall a. (a -> a) -> Endo a
Endo ((b -> b) -> Endo b) -> (b -> b) -> Endo b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
a (a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
g

instance Functor BiEndo where
  fmap :: forall a b. (a <-> b) -> BiEndo a -> BiEndo b
fmap a <-> b
f (BiEndo a <-> a
a) = (b <-> b) -> BiEndo b
forall a. (a <-> a) -> BiEndo a
BiEndo ((b <-> b) -> BiEndo b) -> (b <-> b) -> BiEndo b
forall a b. (a -> b) -> a -> b
$ a <-> b
f (a <-> b) -> Bijection (->) b a -> b <-> b
forall b c a.
Bijection (->) b c -> Bijection (->) a b -> Bijection (->) a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a <-> a
a (a <-> a) -> Bijection (->) b a -> Bijection (->) b a
forall b c a.
Bijection (->) b c -> Bijection (->) a b -> Bijection (->) a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a <-> b) -> Bijection (->) b a
forall b c. Bijection (->) b c -> Bijection (->) c b
forall (a :: * -> * -> *) b c. BiArrow a => a b c -> a c b
invert a <-> b
f