{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.Functor (Functor(..), (<$>), (<$)) where

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

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.<$>)'.
{-# INLINABLE (<$>) #-}
(<$>) :: Functor f => (a -> b) -> f a -> f b
<$> :: (a -> b) -> f a -> f b
(<$>) a -> b
f f a
fa = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
fa

infixl 4 <$
{-# INLINABLE (<$) #-}
-- | Plutus Tx version of '(Data.Functor.<$)'.
(<$) :: Functor f => a -> f b -> f a
<$ :: a -> f b -> f a
(<$) a
a f b
fb = (b -> a) -> f b -> f a
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) f b
fb

instance Functor [] where
    {-# INLINABLE fmap #-}
    fmap :: (a -> b) -> [a] -> [b]
fmap a -> b
f [a]
l = case [a]
l of
            []   -> []
            a
x:[a]
xs -> a -> b
f a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs

instance Functor Maybe where
    {-# INLINABLE fmap #-}
    fmap :: (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
    {-# INLINABLE fmap #-}
    fmap :: (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
    {-# INLINABLE fmap #-}
    fmap :: (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
    {-# INLINABLE fmap #-}
    fmap :: (a -> b) -> Identity a -> Identity b
fmap a -> b
f (Identity a
a) = b -> Identity b
forall a. a -> Identity a
Identity (a -> b
f a
a)

instance Functor (Const m) where
    {-# INLINABLE fmap #-}
    fmap :: (a -> b) -> Const m a -> Const m b
fmap a -> b
_ (Const m
c) = m -> Const m b
forall k a (b :: k). a -> Const a b
Const m
c