-- 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 'Applicative' over arity-1 type constructors.

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Ten.Applicative
         ( Applicative10(..), (<*!), (*>!)
         , liftA310
         , (:->:)(Arr10, runArr10)
         , pure10C, liftA210C, liftA310C
         ) where

import Control.Applicative (liftA2)
import Data.Proxy (Proxy(..))
import GHC.Generics
         ( Generic1(..)
         , (:.:)(..), (:*:)(..)
         , K1(..), M1(..), Rec1(..), U1(..)
         )

import Data.Wrapped (Wrapped1(..))

import Data.Ten.Ap (Ap10(..))
import Data.Ten.Entails (Entails)
import Data.Ten.Functor (Functor10, (<$>!))
import Data.Ten.Functor.WithIndex (Index10, Functor10WithIndex, fmap10C)

infixl 4 <*>!
-- | 'Applicative' over arity-1 type constructors.
--
-- See also 'Functor10' and 'Data.Ten.Foldable.Foldable10'.
class Functor10 f => Applicative10 f where
  {-# MINIMAL pure10, ((<*>!) | liftA210) #-}

  -- | Lift a parametric @m@ value into an @f m@.
  pure10 :: (forall a. m a) -> f m

  -- | ('<*>') for 'Applicative10': zip two @f@s with 'runArr10'.
  (<*>!) :: f (m :->: n) -> f m -> f n
  (<*>!) = (forall (a :: k). (:->:) m n a -> m a -> n a)
-> f (m :->: n) -> f m -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 (\ (Arr10 f') m a
x' -> m a -> n a
f' m a
x')

  -- | 'Control.Applicative.liftA2' for 'Applicative10': zip two @f@s with a
  -- parametric function.
  liftA210 :: (forall a. m a -> n a -> o a) -> f m -> f n -> f o
  liftA210 forall (a :: k). m a -> n a -> o a
f f m
x f n
y = ((n a -> o a) -> (:->:) n o a
forall k (m :: k -> *) (n :: k -> *) (a :: k).
(m a -> n a) -> (:->:) m n a
Arr10 ((n a -> o a) -> (:->:) n o a)
-> (m a -> n a -> o a) -> m a -> (:->:) n o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n a -> o a
forall (a :: k). m a -> n a -> o a
f) (forall (a :: k). m a -> (:->:) n o a) -> f m -> f (n :->: o)
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
<$>! f m
x f (n :->: o) -> f n -> f o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Applicative10 f =>
f (m :->: n) -> f m -> f n
<*>! f n
y

instance (Generic1 f, Applicative10 (Rep1 f))
      => Applicative10 (Wrapped1 Generic1 f) where
  pure10 :: (forall (a :: k). m a) -> Wrapped1 Generic1 f m
pure10 forall (a :: k). m a
x = f m -> Wrapped1 Generic1 f m
forall k (c :: (k -> *) -> Constraint) (f :: k -> *) (a :: k).
f a -> Wrapped1 c f a
Wrapped1 (f m -> Wrapped1 Generic1 f m) -> f m -> Wrapped1 Generic1 f m
forall a b. (a -> b) -> a -> b
$ Rep1 f m -> f m
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f m -> f m) -> Rep1 f m -> f m
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). m a) -> Rep1 f m
forall k (f :: (k -> *) -> *) (m :: k -> *).
Applicative10 f =>
(forall (a :: k). m a) -> f m
pure10 forall (a :: k). m a
x
  liftA210 :: (forall (a :: k). m a -> n a -> o a)
-> Wrapped1 Generic1 f m
-> Wrapped1 Generic1 f n
-> Wrapped1 Generic1 f o
liftA210 forall (a :: k). m a -> n a -> o a
f (Wrapped1 f m
x) (Wrapped1 f n
y) =
    f o -> Wrapped1 Generic1 f o
forall k (c :: (k -> *) -> Constraint) (f :: k -> *) (a :: k).
f a -> Wrapped1 c f a
Wrapped1 (f o -> Wrapped1 Generic1 f o) -> f o -> Wrapped1 Generic1 f o
forall a b. (a -> b) -> a -> b
$ Rep1 f o -> f o
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f o -> f o) -> Rep1 f o -> f o
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). m a -> n a -> o a)
-> Rep1 f m -> Rep1 f n -> Rep1 f o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 forall (a :: k). m a -> n a -> o a
f (f m -> Rep1 f m
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f m
x) (f n -> Rep1 f n
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1 f n
y)

instance Applicative10 (Ap10 a) where
  pure10 :: (forall (a :: k). m a) -> Ap10 a m
pure10 forall (a :: k). m a
x = m a -> Ap10 a m
forall k (a :: k) (f :: k -> *). f a -> Ap10 a f
Ap10 m a
forall (a :: k). m a
x
  liftA210 :: (forall (a :: k). m a -> n a -> o a)
-> Ap10 a m -> Ap10 a n -> Ap10 a o
liftA210 forall (a :: k). m a -> n a -> o a
f (Ap10 m a
x) (Ap10 n a
y) = o a -> Ap10 a o
forall k (a :: k) (f :: k -> *). f a -> Ap10 a f
Ap10 (o a -> Ap10 a o) -> o a -> Ap10 a o
forall a b. (a -> b) -> a -> b
$ m a -> n a -> o a
forall (a :: k). m a -> n a -> o a
f m a
x n a
y

instance Monoid a => Applicative10 (K1 i a) where
  pure10 :: (forall (a :: k). m a) -> K1 i a m
pure10 forall (a :: k). m a
_ = a -> K1 i a m
forall k i c (p :: k). c -> K1 i c p
K1 a
forall a. Monoid a => a
mempty
  liftA210 :: (forall (a :: k). m a -> n a -> o a)
-> K1 i a m -> K1 i a n -> K1 i a o
liftA210 forall (a :: k). m a -> n a -> o a
_ (K1 a
x) (K1 a
y) = a -> K1 i a o
forall k i c (p :: k). c -> K1 i c p
K1 (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)

-- no instance Applicative10 V1: V1 is uninhabited

instance Applicative10 U1 where
  pure10 :: (forall (a :: k). m a) -> U1 m
pure10 forall (a :: k). m a
_ = U1 m
forall k (p :: k). U1 p
U1
  liftA210 :: (forall (a :: k). m a -> n a -> o a) -> U1 m -> U1 n -> U1 o
liftA210 forall (a :: k). m a -> n a -> o a
_ U1 m
U1 U1 n
U1 = U1 o
forall k (p :: k). U1 p
U1

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

-- no instance (Applicative10 f, Applicative10 g) => Applicative10 (f :+: g)

instance (Applicative10 f, Applicative10 g) => Applicative10 (f :*: g) where
  pure10 :: (forall (a :: k). m a) -> (:*:) f g m
pure10 forall (a :: k). m a
x = (forall (a :: k). m a) -> f m
forall k (f :: (k -> *) -> *) (m :: k -> *).
Applicative10 f =>
(forall (a :: k). m a) -> f m
pure10 forall (a :: k). m a
x f m -> g m -> (:*:) f g m
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (forall (a :: k). m a) -> g m
forall k (f :: (k -> *) -> *) (m :: k -> *).
Applicative10 f =>
(forall (a :: k). m a) -> f m
pure10 forall (a :: k). m a
x
  liftA210 :: (forall (a :: k). m a -> n a -> o a)
-> (:*:) f g m -> (:*:) f g n -> (:*:) f g o
liftA210 forall (a :: k). m a -> n a -> o a
f (f m
xl :*: g m
xr) (f n
yl :*: g n
yr) = (forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 forall (a :: k). m a -> n a -> o a
f f m
xl f n
yl f o -> g o -> (:*:) f g o
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (forall (a :: k). m a -> n a -> o a) -> g m -> g n -> g o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 forall (a :: k). m a -> n a -> o a
f g m
xr g n
yr

instance (Applicative f, Applicative10 g) => Applicative10 (f :.: g) where
  pure10 :: (forall (a :: k). m a) -> (:.:) f g m
pure10 forall (a :: k). m a
x = f (g m) -> (:.:) f g m
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g m) -> (:.:) f g m) -> f (g m) -> (:.:) f g m
forall a b. (a -> b) -> a -> b
$ g m -> f (g m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall (a :: k). m a) -> g m
forall k (f :: (k -> *) -> *) (m :: k -> *).
Applicative10 f =>
(forall (a :: k). m a) -> f m
pure10 forall (a :: k). m a
x)
  liftA210 :: (forall (a :: k). m a -> n a -> o a)
-> (:.:) f g m -> (:.:) f g n -> (:.:) f g o
liftA210 forall (a :: k). m a -> n a -> o a
f (Comp1 f (g m)
x) (Comp1 f (g n)
y) = f (g o) -> (:.:) f g o
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g o) -> (:.:) f g o) -> f (g o) -> (:.:) f g o
forall a b. (a -> b) -> a -> b
$ (g m -> g n -> g o) -> f (g m) -> f (g n) -> f (g o)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((forall (a :: k). m a -> n a -> o a) -> g m -> g n -> g o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 forall (a :: k). m a -> n a -> o a
f) f (g m)
x f (g n)
y

-- | A function @m a -> n a@ wrapped in a newtype for use as a type parameter.
--
-- This is used to represent the partially-applied functions in the left side
-- of ('<*>!').
newtype (m :->: n) a = Arr10 { (:->:) m n a -> m a -> n a
runArr10 :: m a -> n a }

-- | 'Control.Applicative.liftA3' for 'Applicative10'.
liftA310
  :: Applicative10 f
  => (forall a. m a -> n a -> o a -> p a) -> f m -> f n -> f o -> f p
liftA310 :: (forall (a :: k). m a -> n a -> o a -> p a)
-> f m -> f n -> f o -> f p
liftA310 forall (a :: k). m a -> n a -> o a -> p a
f f m
xs f n
ys f o
zs =
  (\m a
x -> (n a -> (:->:) o p a) -> (:->:) n (o :->: p) a
forall k (m :: k -> *) (n :: k -> *) (a :: k).
(m a -> n a) -> (:->:) m n a
Arr10 ((o a -> p a) -> (:->:) o p a
forall k (m :: k -> *) (n :: k -> *) (a :: k).
(m a -> n a) -> (:->:) m n a
Arr10 ((o a -> p a) -> (:->:) o p a)
-> (n a -> o a -> p a) -> n a -> (:->:) o p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n a -> o a -> p a
forall (a :: k). m a -> n a -> o a -> p a
f m a
x)) (forall (a :: k). m a -> (:->:) n (o :->: p) a)
-> f m -> f (n :->: (o :->: p))
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Functor10 f =>
(forall (a :: k). m a -> n a) -> f m -> f n
<$>! f m
xs f (n :->: (o :->: p)) -> f n -> f (o :->: p)
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Applicative10 f =>
f (m :->: n) -> f m -> f n
<*>! f n
ys f (o :->: p) -> f o -> f p
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Applicative10 f =>
f (m :->: n) -> f m -> f n
<*>! f o
zs

infixl 4 <*!
-- | ('<*') for 'Applicative10'.
(<*!) :: Applicative10 f => f m -> f n -> f m
<*! :: f m -> f n -> f m
(<*!) = (forall (a :: k). m a -> n a -> m a) -> f m -> f n -> f m
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 forall (a :: k). m a -> n a -> m a
forall a b. a -> b -> a
const

infixl 4 *>!
-- | ('*>') for 'Applicative10'.
(*>!) :: Applicative10 f => f m -> f n -> f n
*>! :: f m -> f n -> f n
(*>!) = (forall (a :: k). m a -> n a -> n a) -> f m -> f n -> f n
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *)
       (o :: k -> *).
Applicative10 f =>
(forall (a :: k). m a -> n a -> o a) -> f m -> f n -> f o
liftA210 ((n a -> n a) -> m a -> n a -> n a
forall a b. a -> b -> a
const n a -> n a
forall a. a -> a
id)

-- | 'pure10' with access to an instance for every element.
pure10C
  :: forall c f m
   . (Entails (Index10 f) c, Applicative10 f, Functor10WithIndex f)
  => (forall a. c a => m a) -> f m
pure10C :: (forall (a :: k). c a => m a) -> f m
pure10C forall (a :: k). c a => m a
x = (forall (a :: k). c a => Proxy a -> m a) -> f Proxy -> f m
forall k (c :: k -> Constraint) (f :: (k -> *) -> *) (m :: k -> *)
       (n :: k -> *).
(Entails (Index10 f) c, Functor10WithIndex f) =>
(forall (a :: k). c a => m a -> n a) -> f m -> f n
fmap10C @c (m a -> Proxy a -> m a
forall a b. a -> b -> a
const m a
forall (a :: k). c a => m a
x) ((forall (a :: k). Proxy a) -> f Proxy
forall k (f :: (k -> *) -> *) (m :: k -> *).
Applicative10 f =>
(forall (a :: k). m a) -> f m
pure10 forall (a :: k). Proxy a
forall k (t :: k). Proxy t
Proxy)

-- | 'liftA210' with access to an instance for every element.
liftA210C
  :: forall c f m n o
   . (Entails (Index10 f) c, Applicative10 f, Functor10WithIndex f)
  => (forall a. c a => m a -> n a -> o a)
  -> f m -> f n -> f o
liftA210C :: (forall (a :: k). c a => m a -> n a -> o a) -> f m -> f n -> f o
liftA210C forall (a :: k). c a => m a -> n a -> o a
f f m
x f n
y = (forall (a :: k). c a => m a -> (:->:) n o a)
-> f m -> f (n :->: o)
forall k (c :: k -> Constraint) (f :: (k -> *) -> *) (m :: k -> *)
       (n :: k -> *).
(Entails (Index10 f) c, Functor10WithIndex f) =>
(forall (a :: k). c a => m a -> n a) -> f m -> f n
fmap10C @c ((n a -> o a) -> (:->:) n o a
forall k (m :: k -> *) (n :: k -> *) (a :: k).
(m a -> n a) -> (:->:) m n a
Arr10 ((n a -> o a) -> (:->:) n o a)
-> (m a -> n a -> o a) -> m a -> (:->:) n o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n a -> o a
forall (a :: k). c a => m a -> n a -> o a
f) f m
x f (n :->: o) -> f n -> f o
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Applicative10 f =>
f (m :->: n) -> f m -> f n
<*>! f n
y

-- | 'liftA310' with access to an instance for every element.
liftA310C
  :: forall c f m n o p
   . (Entails (Index10 f) c, Applicative10 f, Functor10WithIndex f)
  => (forall a. c a => m a -> n a -> o a -> p a)
  -> f m -> f n -> f o -> f p
liftA310C :: (forall (a :: k). c a => m a -> n a -> o a -> p a)
-> f m -> f n -> f o -> f p
liftA310C forall (a :: k). c a => m a -> n a -> o a -> p a
f f m
x f n
y f o
z = (forall (a :: k). c a => m a -> n a -> (:->:) o p a)
-> f m -> f n -> f (o :->: p)
forall k (c :: k -> Constraint) (f :: (k -> *) -> *) (m :: k -> *)
       (n :: k -> *) (o :: k -> *).
(Entails (Index10 f) c, Applicative10 f, Functor10WithIndex f) =>
(forall (a :: k). c a => m a -> n a -> o a) -> f m -> f n -> f o
liftA210C @c (((o a -> p a) -> (:->:) o p a)
-> (n a -> o a -> p a) -> n a -> (:->:) o p a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (o a -> p a) -> (:->:) o p a
forall k (m :: k -> *) (n :: k -> *) (a :: k).
(m a -> n a) -> (:->:) m n a
Arr10 ((n a -> o a -> p a) -> n a -> (:->:) o p a)
-> (m a -> n a -> o a -> p a) -> m a -> n a -> (:->:) o p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n a -> o a -> p a
forall (a :: k). c a => m a -> n a -> o a -> p a
f) f m
x f n
y f (o :->: p) -> f o -> f p
forall k (f :: (k -> *) -> *) (m :: k -> *) (n :: k -> *).
Applicative10 f =>
f (m :->: n) -> f m -> f n
<*>! f o
z