{-# LANGUAGE RebindableSyntax #-}
-- |
-- Module      : Data.Array.Accelerate.Data.Functor
-- Copyright   : [2018..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- A functor performs a uniform action over a parameterised type
--
-- This is essentially the same as the standard Haskell 'Prelude.Functor' class,
-- lifted to Accelerate 'Exp' terms.
--
-- @since 1.2.0.0
--

module Data.Array.Accelerate.Data.Functor (

  Functor(..),
  (<$>),
  ($>),
  void,

) where

import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Lift
import Data.Array.Accelerate.Smart

import Data.Monoid
import Data.Semigroup
import Prelude                                                      ( (.), const, flip )


-- | The 'Functor' class is used for scalar types which can be mapped over.
-- Instances of 'Functor' should satisfy the following laws:
--
-- > fmap id      == id
-- > fmap (f . g) == fmap f . fmap g
--
class Functor f where
  fmap :: (Elt a, Elt b, Elt (f a), Elt (f b)) => (Exp a -> Exp b) -> Exp (f a) -> Exp (f b)

  -- | Replace all locations in the input with the same value. The default
  -- definition is @fmap . const@, but this may be overridden with a more
  -- efficient version.
  --
  infixl 4 <$
  (<$) :: (Elt a, Elt b, Elt (f a), Elt (f b)) => Exp a -> Exp (f b) -> Exp (f a)
  (<$) = (Exp b -> Exp a) -> Exp (f b) -> Exp (f a)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap ((Exp b -> Exp a) -> Exp (f b) -> Exp (f a))
-> (Exp a -> Exp b -> Exp a) -> Exp a -> Exp (f b) -> Exp (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp a -> Exp b -> Exp a
forall a b. a -> b -> a
const


-- | An infix synonym for 'fmap'
--
-- The name of this operator is an allusion to 'Prelude.$'. Note the
-- similarities between their types:
--
-- >  ($)  ::              (Exp a -> Exp b) -> Exp a     -> Exp b
-- > (<$>) :: Functor f => (Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
--
-- Whereas 'Prelude.$' is function application, '<$>' is function application
-- lifted over a 'Functor'.
--
infixl 4 <$>
(<$>) :: (Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) => (Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
<$> :: (Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
(<$>) = (Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap


-- | A flipped version of '(<$)'.
--
infixl 4 $>
($>) :: (Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) => Exp (f a) -> Exp b -> Exp (f b)
$> :: Exp (f a) -> Exp b -> Exp (f b)
($>) = (Exp b -> Exp (f a) -> Exp (f b))
-> Exp (f a) -> Exp b -> Exp (f b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Exp b -> Exp (f a) -> Exp (f b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
Exp a -> Exp (f b) -> Exp (f a)
(<$)


-- | @'void' value@ discards or ignores the result of evaluation.
--
void :: (Functor f, Elt a, Elt (f a), Elt (f ())) => Exp (f a) -> Exp (f ())
void :: Exp (f a) -> Exp (f ())
void Exp (f a)
x = () -> Exp ()
forall e. (HasCallStack, Elt e) => e -> Exp e
constant () Exp () -> Exp (f a) -> Exp (f ())
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
Exp a -> Exp (f b) -> Exp (f a)
<$ Exp (f a)
x


instance Functor Sum where
  fmap :: (Exp a -> Exp b) -> Exp (Sum a) -> Exp (Sum b)
fmap Exp a -> Exp b
f = (Exp (Sum a) -> Exp (Sum b))
-> Exp (Plain (Exp (Sum a))) -> Exp (Plain (Exp (Sum b)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 ((Exp a -> Exp b) -> Exp (Sum a) -> Exp (Sum b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap Exp a -> Exp b
f)

instance Functor Product where
  fmap :: (Exp a -> Exp b) -> Exp (Product a) -> Exp (Product b)
fmap Exp a -> Exp b
f = (Exp (Product a) -> Exp (Product b))
-> Exp (Plain (Exp (Product a))) -> Exp (Plain (Exp (Product b)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 ((Exp a -> Exp b) -> Exp (Product a) -> Exp (Product b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap Exp a -> Exp b
f)

instance Functor Min where
  fmap :: (Exp a -> Exp b) -> Exp (Min a) -> Exp (Min b)
fmap Exp a -> Exp b
f = (Exp (Min a) -> Exp (Min b))
-> Exp (Plain (Exp (Min a))) -> Exp (Plain (Exp (Min b)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 ((Exp a -> Exp b) -> Exp (Min a) -> Exp (Min b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap Exp a -> Exp b
f)

instance Functor Max where
  fmap :: (Exp a -> Exp b) -> Exp (Max a) -> Exp (Max b)
fmap Exp a -> Exp b
f = (Exp (Max a) -> Exp (Max b))
-> Exp (Plain (Exp (Max a))) -> Exp (Plain (Exp (Max b)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 ((Exp a -> Exp b) -> Exp (Max a) -> Exp (Max b)
forall (f :: * -> *) a b.
(Functor f, Elt a, Elt b, Elt (f a), Elt (f b)) =>
(Exp a -> Exp b) -> Exp (f a) -> Exp (f b)
fmap Exp a -> Exp b
f)