{-# 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.<$>)'.
{-# INLINABLE (<$>) #-}
(<$>) :: 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

infixl 1 <&>
-- | Plutus Tx version of '(Data.Functor.<&>)'.
{-# INLINABLE (<&>) #-}
(<&>) :: 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

infixl 4 <$
{-# INLINABLE (<$) #-}
-- | 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)

instance Functor [] where
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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
    {-# INLINABLE 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)