module Proarrow.Functor where

import Data.Functor.Compose (Compose (..))
import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity)
import Data.Kind (Constraint, Type)
import Data.List.NonEmpty qualified as P
import Prelude qualified as P

import Proarrow.Core (CategoryOf (..), Promonad (..), Profunctor, rmap, type (+->))
import Proarrow.Object (Ob')

infixr 0 .~>
type f .~> g = forall a. (Ob a) => f a ~> g a

type Functor :: forall {k1} {k2}. (k1 -> k2) -> Constraint
class (CategoryOf k1, CategoryOf k2, forall a. (Ob a) => Ob' (f a)) => Functor (f :: k1 -> k2) where
  map :: a ~> b -> f a ~> f b

-- Can't make an instance Functor (f :: Type -> Type) because that would overlap with instances of kind k -> Type
newtype Prelude f a = Prelude {forall {k} (f :: k -> Type) (a :: k). Prelude f a -> f a
unPrelude :: f a}
  deriving ((forall a b. (a -> b) -> Prelude f a -> Prelude f b)
-> (forall a b. a -> Prelude f b -> Prelude f a)
-> Functor (Prelude f)
forall a b. a -> Prelude f b -> Prelude f a
forall a b. (a -> b) -> Prelude f a -> Prelude f b
forall (f :: Type -> Type) a b.
Functor f =>
a -> Prelude f b -> Prelude f a
forall (f :: Type -> Type) a b.
Functor f =>
(a -> b) -> Prelude f a -> Prelude f b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: Type -> Type) a b.
Functor f =>
(a -> b) -> Prelude f a -> Prelude f b
fmap :: forall a b. (a -> b) -> Prelude f a -> Prelude f b
$c<$ :: forall (f :: Type -> Type) a b.
Functor f =>
a -> Prelude f b -> Prelude f a
<$ :: forall a b. a -> Prelude f b -> Prelude f a
P.Functor, (forall m. Monoid m => Prelude f m -> m)
-> (forall m a. Monoid m => (a -> m) -> Prelude f a -> m)
-> (forall m a. Monoid m => (a -> m) -> Prelude f a -> m)
-> (forall a b. (a -> b -> b) -> b -> Prelude f a -> b)
-> (forall a b. (a -> b -> b) -> b -> Prelude f a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prelude f a -> b)
-> (forall b a. (b -> a -> b) -> b -> Prelude f a -> b)
-> (forall a. (a -> a -> a) -> Prelude f a -> a)
-> (forall a. (a -> a -> a) -> Prelude f a -> a)
-> (forall a. Prelude f a -> [a])
-> (forall a. Prelude f a -> Bool)
-> (forall a. Prelude f a -> Int)
-> (forall a. Eq a => a -> Prelude f a -> Bool)
-> (forall a. Ord a => Prelude f a -> a)
-> (forall a. Ord a => Prelude f a -> a)
-> (forall a. Num a => Prelude f a -> a)
-> (forall a. Num a => Prelude f a -> a)
-> Foldable (Prelude f)
forall a. Eq a => a -> Prelude f a -> Bool
forall a. Num a => Prelude f a -> a
forall a. Ord a => Prelude f a -> a
forall m. Monoid m => Prelude f m -> m
forall a. Prelude f a -> Bool
forall a. Prelude f a -> Int
forall a. Prelude f a -> [a]
forall a. (a -> a -> a) -> Prelude f a -> a
forall m a. Monoid m => (a -> m) -> Prelude f a -> m
forall b a. (b -> a -> b) -> b -> Prelude f a -> b
forall a b. (a -> b -> b) -> b -> Prelude f a -> b
forall (f :: Type -> Type) a.
(Foldable f, Eq a) =>
a -> Prelude f a -> Bool
forall (f :: Type -> Type) a.
(Foldable f, Num a) =>
Prelude f a -> a
forall (f :: Type -> Type) a.
(Foldable f, Ord a) =>
Prelude f a -> a
forall (f :: Type -> Type) m.
(Foldable f, Monoid m) =>
Prelude f m -> m
forall (f :: Type -> Type) a. Foldable f => Prelude f a -> Bool
forall (f :: Type -> Type) a. Foldable f => Prelude f a -> Int
forall (f :: Type -> Type) a. Foldable f => Prelude f a -> [a]
forall (f :: Type -> Type) a.
Foldable f =>
(a -> a -> a) -> Prelude f a -> a
forall (f :: Type -> Type) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Prelude f a -> m
forall (f :: Type -> Type) b a.
Foldable f =>
(b -> a -> b) -> b -> Prelude f a -> b
forall (f :: Type -> Type) a b.
Foldable f =>
(a -> b -> b) -> b -> Prelude f a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (f :: Type -> Type) m.
(Foldable f, Monoid m) =>
Prelude f m -> m
fold :: forall m. Monoid m => Prelude f m -> m
$cfoldMap :: forall (f :: Type -> Type) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Prelude f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Prelude f a -> m
$cfoldMap' :: forall (f :: Type -> Type) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Prelude f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Prelude f a -> m
$cfoldr :: forall (f :: Type -> Type) a b.
Foldable f =>
(a -> b -> b) -> b -> Prelude f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Prelude f a -> b
$cfoldr' :: forall (f :: Type -> Type) a b.
Foldable f =>
(a -> b -> b) -> b -> Prelude f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Prelude f a -> b
$cfoldl :: forall (f :: Type -> Type) b a.
Foldable f =>
(b -> a -> b) -> b -> Prelude f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Prelude f a -> b
$cfoldl' :: forall (f :: Type -> Type) b a.
Foldable f =>
(b -> a -> b) -> b -> Prelude f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Prelude f a -> b
$cfoldr1 :: forall (f :: Type -> Type) a.
Foldable f =>
(a -> a -> a) -> Prelude f a -> a
foldr1 :: forall a. (a -> a -> a) -> Prelude f a -> a
$cfoldl1 :: forall (f :: Type -> Type) a.
Foldable f =>
(a -> a -> a) -> Prelude f a -> a
foldl1 :: forall a. (a -> a -> a) -> Prelude f a -> a
$ctoList :: forall (f :: Type -> Type) a. Foldable f => Prelude f a -> [a]
toList :: forall a. Prelude f a -> [a]
$cnull :: forall (f :: Type -> Type) a. Foldable f => Prelude f a -> Bool
null :: forall a. Prelude f a -> Bool
$clength :: forall (f :: Type -> Type) a. Foldable f => Prelude f a -> Int
length :: forall a. Prelude f a -> Int
$celem :: forall (f :: Type -> Type) a.
(Foldable f, Eq a) =>
a -> Prelude f a -> Bool
elem :: forall a. Eq a => a -> Prelude f a -> Bool
$cmaximum :: forall (f :: Type -> Type) a.
(Foldable f, Ord a) =>
Prelude f a -> a
maximum :: forall a. Ord a => Prelude f a -> a
$cminimum :: forall (f :: Type -> Type) a.
(Foldable f, Ord a) =>
Prelude f a -> a
minimum :: forall a. Ord a => Prelude f a -> a
$csum :: forall (f :: Type -> Type) a.
(Foldable f, Num a) =>
Prelude f a -> a
sum :: forall a. Num a => Prelude f a -> a
$cproduct :: forall (f :: Type -> Type) a.
(Foldable f, Num a) =>
Prelude f a -> a
product :: forall a. Num a => Prelude f a -> a
P.Foldable, Functor (Prelude f)
Foldable (Prelude f)
(Functor (Prelude f), Foldable (Prelude f)) =>
(forall (f :: Type -> Type) a b.
 Applicative f =>
 (a -> f b) -> Prelude f a -> f (Prelude f b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Prelude f (f a) -> f (Prelude f a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Prelude f a -> m (Prelude f b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Prelude f (m a) -> m (Prelude f a))
-> Traversable (Prelude f)
forall (t :: Type -> Type).
(Functor t, Foldable t) =>
(forall (f :: Type -> Type) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: Type -> Type). Traversable f => Functor (Prelude f)
forall (f :: Type -> Type). Traversable f => Foldable (Prelude f)
forall (f :: Type -> Type) (m :: Type -> Type) a.
(Traversable f, Monad m) =>
Prelude f (m a) -> m (Prelude f a)
forall (f :: Type -> Type) (f :: Type -> Type) a.
(Traversable f, Applicative f) =>
Prelude f (f a) -> f (Prelude f a)
forall (f :: Type -> Type) (m :: Type -> Type) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Prelude f a -> m (Prelude f b)
forall (f :: Type -> Type) (f :: Type -> Type) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Prelude f a -> f (Prelude f b)
forall (m :: Type -> Type) a.
Monad m =>
Prelude f (m a) -> m (Prelude f a)
forall (f :: Type -> Type) a.
Applicative f =>
Prelude f (f a) -> f (Prelude f a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Prelude f a -> m (Prelude f b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Prelude f a -> f (Prelude f b)
$ctraverse :: forall (f :: Type -> Type) (f :: Type -> Type) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Prelude f a -> f (Prelude f b)
traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Prelude f a -> f (Prelude f b)
$csequenceA :: forall (f :: Type -> Type) (f :: Type -> Type) a.
(Traversable f, Applicative f) =>
Prelude f (f a) -> f (Prelude f a)
sequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Prelude f (f a) -> f (Prelude f a)
$cmapM :: forall (f :: Type -> Type) (m :: Type -> Type) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Prelude f a -> m (Prelude f b)
mapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Prelude f a -> m (Prelude f b)
$csequence :: forall (f :: Type -> Type) (m :: Type -> Type) a.
(Traversable f, Monad m) =>
Prelude f (m a) -> m (Prelude f a)
sequence :: forall (m :: Type -> Type) a.
Monad m =>
Prelude f (m a) -> m (Prelude f a)
P.Traversable)
instance (P.Functor f) => Functor (Prelude f) where
  map :: forall a b. (a ~> b) -> Prelude f a ~> Prelude f b
map a ~> b
f = f b -> Prelude f b
forall {k} (f :: k -> Type) (a :: k). f a -> Prelude f a
Prelude (f b -> Prelude f b)
-> (Prelude f a -> f b) -> Prelude f a -> Prelude f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
P.fmap a ~> b
a -> b
f (f a -> f b) -> (Prelude f a -> f a) -> Prelude f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. Prelude f a -> f a
forall {k} (f :: k -> Type) (a :: k). Prelude f a -> f a
unPrelude

deriving via Prelude ((,) a) instance Functor ((,) a)
deriving via Prelude (P.Either a) instance Functor (P.Either a)
deriving via Prelude P.IO instance Functor P.IO
deriving via Prelude P.Maybe instance Functor P.Maybe
deriving via Prelude P.NonEmpty instance Functor P.NonEmpty
deriving via Prelude ((->) a) instance Functor ((->) a)
deriving via Prelude [] instance Functor []
deriving via Prelude Identity instance Functor Identity

instance (CategoryOf k) => Functor (Const x :: k -> Type) where
  map :: forall (a :: k) (b :: k). (a ~> b) -> Const x a ~> Const x b
map a ~> b
_ (Const x
x) = x -> Const x b
forall {k} a (b :: k). a -> Const a b
Const x
x

instance (Functor f, Functor g) => Functor (Compose f g) where
  map :: forall (a :: k1) (b :: k1).
(a ~> b) -> Compose f g a ~> Compose f g b
map a ~> b
f = f (g b) -> Compose f g b
forall {k} {k1} (f :: k -> Type) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g b) -> Compose f g b)
-> (Compose f g a -> f (g b)) -> Compose f g a -> Compose f g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. (g a ~> g b) -> f (g a) ~> f (g b)
forall (a :: k) (b :: k). (a ~> b) -> f a ~> f b
forall {k1} {k2} (f :: k1 -> k2) (a :: k1) (b :: k1).
Functor f =>
(a ~> b) -> f a ~> f b
map ((a ~> b) -> g a ~> g b
forall (a :: k1) (b :: k1). (a ~> b) -> g a ~> g b
forall {k1} {k2} (f :: k1 -> k2) (a :: k1) (b :: k1).
Functor f =>
(a ~> b) -> f a ~> f b
map a ~> b
f) (f (g a) -> f (g b))
-> (Compose f g a -> f (g a)) -> Compose f g a -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> Type) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

newtype FromProfunctor p a b = FromProfunctor {forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k).
FromProfunctor p a b -> p a b
unFromProfunctor :: p a b}
instance (Profunctor p) => Functor (FromProfunctor p a) where
  map :: forall (a :: k1) (b :: k1).
(a ~> b) -> FromProfunctor p a a ~> FromProfunctor p a b
map a ~> b
f = p a b -> FromProfunctor p a b
forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k).
p a b -> FromProfunctor p a b
FromProfunctor (p a b -> FromProfunctor p a b)
-> (FromProfunctor p a a -> p a b)
-> FromProfunctor p a a
-> FromProfunctor p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. (a ~> b) -> p a a -> p a b
forall {j} {k} (p :: PRO j k) (b :: k) (d :: k) (a :: j).
Profunctor p =>
(b ~> d) -> p a b -> p a d
rmap a ~> b
f (p a a -> p a b)
-> (FromProfunctor p a a -> p a a) -> FromProfunctor p a a -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. FromProfunctor p a a -> p a a
forall {k} {k} (p :: k -> k -> Type) (a :: k) (b :: k).
FromProfunctor p a b -> p a b
unFromProfunctor
instance (Profunctor p) => P.Functor (FromProfunctor p a) where
  fmap :: forall a b.
(a -> b) -> FromProfunctor p a a -> FromProfunctor p a b
fmap = (a ~> b) -> FromProfunctor p a a ~> FromProfunctor p a b
(a -> b) -> FromProfunctor p a a -> FromProfunctor p a b
forall a b.
(a ~> b) -> FromProfunctor p a a ~> FromProfunctor p a b
forall {k1} {k2} (f :: k1 -> k2) (a :: k1) (b :: k1).
Functor f =>
(a ~> b) -> f a ~> f b
map

-- | Presheaves are functors but it makes more sense in proarrow to represent them as profunctors from the unit category.
type Presheaf k = () +-> k
-- | Copresheaves are functors but it makes more sense in proarrow to represent them as profunctors into the unit category.
type Copresheaf k = k +-> ()