{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- 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
<<..>> :: p a c -> p (a -> b) (c -> d) -> p b d
(<<..>>) = (a -> (a -> b) -> b)
-> (c -> (c -> d) -> d) -> 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 (((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a. a -> a
id) (((c -> d) -> c -> d) -> c -> (c -> d) -> d
forall a b c. (a -> b -> c) -> b -> a -> c
flip (c -> d) -> c -> d
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 :: (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 = (a -> b -> c) -> (d -> e -> f) -> w a d -> w (b -> c) (e -> f)
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 (w a d -> w (b -> c) (e -> f)) -> w a d -> w (b -> c) (e -> f)
forall a b. (a -> b) -> a -> b
<<$>> w a d
a w (b -> c) (e -> f) -> w b e -> w c f
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 :: (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 = (a -> b -> c -> d)
-> (e -> f -> g -> h) -> w a e -> w (b -> c -> d) (f -> g -> h)
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 (w a e -> w (b -> c -> d) (f -> g -> h))
-> w a e -> w (b -> c -> d) (f -> g -> h)
forall a b. (a -> b) -> a -> b
<<$>> w a e
a w (b -> c -> d) (f -> g -> h) -> w b f -> w (c -> d) (g -> h)
forall (p :: * -> * -> *) a b c d.
Biapply p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<.>> w b f
b w (c -> d) (g -> h) -> w c g -> w d h
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 #-}