-- Copyright 2018-2021 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

-- | Provides an analog of 'Functor' over arity-1 type constructors.

{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Ten.Functor
         ( Functor10(..), (<$!), (<$>!), void10
         ) where

import Data.Kind (Type)
import Data.Proxy (Proxy(..))
import GHC.Generics
         ( Generic1(..)
         , (:.:)(..), (:*:)(..), (:+:)(..)
         , M1(..), Rec1(..), U1(..), V1, K1(..)
         )

import Data.Wrapped (Wrapped1(..))

import Data.Ten.Ap (Ap10(..))

-- | 'Functor' over arity-1 type constructors.
--
-- Whereas 'Functor' maps @a :: Type@ values to @b :: Type@ values, 'Functor10'
-- maps @(m :: k -> Type) a@ values to @m b@ values, parametrically in @a@.
-- That is, the type parameter of 'Functor' has arity 0, and the type
-- parameter of 'Functor10' has arity 1.
class Functor10 (f :: (k -> Type) -> Type) where
  -- | Map each @m a@ value in @f m@ parametrically to @n a@ to get @f m@.
  fmap10 :: (forall a. m a -> n a) -> f m -> f n

instance (Generic1 f, Functor10 (Rep1 f))
      => Functor10 (Wrapped1 Generic1 f) where
  fmap10 :: (forall (a :: k). m a -> n a)
-> Wrapped1 Generic1 f m -> Wrapped1 Generic1 f n
fmap10 forall (a :: k). m a -> n a
f = f n -> Wrapped1 Generic1 f n
forall k (c :: (k -> *) -> Constraint) (f :: k -> *) (a :: k).
f a -> Wrapped1 c f a
Wrapped1 (f n -> Wrapped1 Generic1 f n)
-> (Wrapped1 Generic1 f m -> f n)
-> Wrapped1 Generic1 f m
-> Wrapped1 Generic1 f n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep1 f n -> f n
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f n -> f n)
-> (Wrapped1 Generic1 f m -> Rep1 f n)
-> Wrapped1 Generic1 f m
-> f n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). m a -> n a) -> Rep1 f m -> Rep1 f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f (Rep1 f m -> Rep1 f n)
-> (Wrapped1 Generic1 f m -> Rep1 f m)
-> Wrapped1 Generic1 f m
-> Rep1 f n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f m -> Rep1 f m
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 (f m -> Rep1 f m)
-> (Wrapped1 Generic1 f m -> f m)
-> Wrapped1 Generic1 f m
-> Rep1 f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrapped1 Generic1 f m -> f m
forall k (c :: (k -> *) -> Constraint) (f :: k -> *) (a :: k).
Wrapped1 c f a -> f a
unWrapped1

instance Functor10 (Ap10 a) where
  fmap10 :: (forall (a :: k). m a -> n a) -> Ap10 a m -> Ap10 a n
fmap10 forall (a :: k). m a -> n a
f (Ap10 m a
x) = n a -> Ap10 a n
forall k (a :: k) (f :: k -> *). f a -> Ap10 a f
Ap10 (m a -> n a
forall (a :: k). m a -> n a
f m a
x)

instance Functor10 (K1 i a) where
  fmap10 :: (forall (a :: k). m a -> n a) -> K1 i a m -> K1 i a n
fmap10 forall (a :: k). m a -> n a
_ (K1 a
x) = a -> K1 i a n
forall k i c (p :: k). c -> K1 i c p
K1 a
x

instance Functor10 V1 where
  fmap10 :: (forall (a :: k). m a -> n a) -> V1 m -> V1 n
fmap10 forall (a :: k). m a -> n a
_ V1 m
x = case V1 m
x of {}

instance Functor10 U1 where
  fmap10 :: (forall (a :: k). m a -> n a) -> U1 m -> U1 n
fmap10 forall (a :: k). m a -> n a
_ U1 m
U1 = U1 n
forall k (p :: k). U1 p
U1

deriving instance Functor10 f => Functor10 (Rec1 f)
deriving instance Functor10 f => Functor10 (M1 i c f)

instance (Functor10 f, Functor10 g) => Functor10 (f :+: g) where
  fmap10 :: (forall (a :: k). m a -> n a) -> (:+:) f g m -> (:+:) f g n
fmap10 forall (a :: k). m a -> n a
f (L1 f m
x) = f n -> (:+:) f g n
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((forall (a :: k). m a -> n a) -> f m -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f f m
x)
  fmap10 forall (a :: k). m a -> n a
f (R1 g m
x) = g n -> (:+:) f g n
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((forall (a :: k). m a -> n a) -> g m -> g n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f g m
x)

instance (Functor10 f, Functor10 g) => Functor10 (f :*: g) where
  fmap10 :: (forall (a :: k). m a -> n a) -> (:*:) f g m -> (:*:) f g n
fmap10 forall (a :: k). m a -> n a
f (f m
l :*: g m
r) = (forall (a :: k). m a -> n a) -> f m -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f f m
l f n -> g n -> (:*:) f g n
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (forall (a :: k). m a -> n a) -> g m -> g n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f g m
r

instance (Functor f, Functor10 g) => Functor10 (f :.: g) where
  fmap10 :: (forall (a :: k). m a -> n a) -> (:.:) f g m -> (:.:) f g n
fmap10 forall (a :: k). m a -> n a
f (Comp1 f (g m)
x) = f (g n) -> (:.:) f g n
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g n) -> (:.:) f g n) -> f (g n) -> (:.:) f g n
forall a b. (a -> b) -> a -> b
$ (g m -> g n) -> f (g m) -> f (g n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall (a :: k). m a -> n a) -> g m -> g n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 forall (a :: k). m a -> n a
f) f (g m)
x

infixl 4 <$!
-- | ('<$') for 'Functor10'.
(<$!) :: Functor10 f => (forall a. n a) -> f m -> f n
forall (a :: k). n a
x <$! :: (forall (a :: k). n a) -> f m -> f n
<$! f m
f = (forall (a :: k). m a -> n a) -> f m -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 (n a -> m a -> n a
forall a b. a -> b -> a
const n a
forall (a :: k). n a
x) f m
f

infixl 4 <$>!
-- | ('<$>') for 'Functor10'.
(<$>!) :: Functor10 f => (forall a. m a -> n a) -> f m -> f n
<$>! :: (forall (a :: k). m a -> n a) -> f m -> f n
(<$>!) = (forall (a :: k). m a -> n a) -> f m -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10

-- | 'Data.Functor.void' for 'Functor10'.
--
-- This returns @f 'Proxy'@ because @Proxy :: k -> Type@ has the right kind and
-- carries no runtime information.  It's isomorphic to @Const ()@ but easier to
-- spell.
void10 :: Functor10 f => f m -> f Proxy
void10 :: f m -> f Proxy
void10 = (forall (a :: k). m a -> Proxy a) -> f m -> f Proxy
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
fmap10 (Proxy a -> m a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy)