{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase   #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module PlutusTx.Functor (Functor (..), (<$>), (<&>), (<$)) where

import Control.Applicative (Const (..))
import Data.Functor.Identity (Identity (..))

import Data.Coerce (coerce)
import PlutusTx.Base
import PlutusTx.Either (Either (..))
import Prelude (Maybe (..))

{- HLINT ignore -}

-- | Plutus Tx version of 'Data.Functor.Functor'.
class Functor f where
  -- | Plutus Tx version of 'Data.Functor.fmap'.
  fmap :: (a -> b) -> f a -> f b

-- (<$) deliberately omitted, to make this a one-method class which has a
-- simpler representation

infixl 4 <$>

-- | Plutus Tx version of '(Data.Functor.<$>)'.
(<$>) :: (Functor f) => (a -> b) -> f a -> f b
<$> :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) = (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINEABLE (<$>) #-}

infixl 1 <&>

-- | Plutus Tx version of '(Data.Functor.<&>)'.
(<&>) :: (Functor f) => f a -> (a -> b) -> f b
f a
as <&> :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> a -> b
f = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
as
{-# INLINEABLE (<&>) #-}

infixl 4 <$

-- | Plutus Tx version of '(Data.Functor.<$)'.
(<$) :: (Functor f) => a -> f b -> f a
<$ :: forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) a
a = (b -> a) -> f b -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> a
forall a b. a -> b -> a
const a
a)
{-# INLINEABLE (<$) #-}

instance Functor [] where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> [a] -> [b]
fmap a -> b
f = [a] -> [b]
go
   where
    go :: [a] -> [b]
go = \case
      [] -> []
      a
x : [a]
xs -> a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a] -> [b]
go [a]
xs

instance Functor Maybe where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Maybe a -> Maybe b
fmap a -> b
f (Just a
a) = b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
f a
a)
  fmap a -> b
_ Maybe a
Nothing  = Maybe b
forall a. Maybe a
Nothing

instance Functor (Either c) where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Either c a -> Either c b
fmap a -> b
f (Right a
a) = b -> Either c b
forall a b. b -> Either a b
Right (a -> b
f a
a)
  fmap a -> b
_ (Left c
c)  = c -> Either c b
forall a b. a -> Either a b
Left c
c

instance Functor ((,) c) where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> (c, a) -> (c, b)
fmap a -> b
f (c
c, a
a) = (c
c, a -> b
f a
a)

instance Functor Identity where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Identity a -> Identity b
  fmap :: forall a b. (a -> b) -> Identity a -> Identity b
fmap = ((a -> b) -> a -> b) -> (a -> b) -> Identity a -> Identity b
forall a b. Coercible a b => a -> b
coerce ((a -> b) -> a -> b
forall a. a -> a
id :: (a -> b) -> a -> b)

instance Functor (Const m) where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Const m a -> Const m b
fmap a -> b
_ = (m -> m) -> Const m a -> Const m b
forall a b. Coercible a b => a -> b
coerce (m -> m
forall a. a -> a
id :: m -> m)