{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2011-2015 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Bifunctor.Apply (
  -- * Biappliable bifunctors
    Bifunctor(..)
  , Biapply(..)
  , (<<$>>)
  , (<<..>>)
  , bilift2
  , bilift3
  ) where

import Data.Functor.Bind.Class
import Data.Biapplicative

infixl 4 <<..>>

(<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d
<<..>> :: forall (p :: * -> * -> *) a c b d.
Biapply p =>
p a c -> p (a -> b) (c -> d) -> p b d
(<<..>>) = forall (w :: * -> * -> *) a b c d e f.
Biapply w =>
(a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f
bilift2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a
id) (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a
id)
{-# INLINE (<<..>>) #-}

-- | Lift binary functions
bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f
bilift2 :: forall (w :: * -> * -> *) a b c d e f.
Biapply w =>
(a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f
bilift2 a -> b -> c
f d -> e -> f
g w a d
a w b e
b = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b -> c
f d -> e -> f
g forall a b. (a -> b) -> a -> b
<<$>> w a d
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> w b e
b
{-# INLINE bilift2 #-}

-- | Lift ternary functions
bilift3 :: Biapply w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
bilift3 :: forall (w :: * -> * -> *) a b c d e f g h.
Biapply w =>
(a -> b -> c -> d)
-> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h
bilift3 a -> b -> c -> d
f e -> f -> g -> h
g w a e
a w b f
b w c g
c = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b -> c -> d
f e -> f -> g -> h
g forall a b. (a -> b) -> a -> b
<<$>> w a e
a forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> w b f
b forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> w c g
c
{-# INLINE bilift3 #-}