module Data.Functor.Identity (Identity (..)) where

import "morphisms" Control.Morphism ((.), ($))

import Control.Functor.Extractable (Extractable (extract))
import Control.Functor.Pointable (Pointable (point))
import Control.Functor.Covariant (Covariant ((<$>), comap))
import Control.Functor.Applicative (Applicative ((<*>)))
import Control.Functor.Traversable (Traversable ((->>)))
import Control.Functor.Distributive (Distributive ((>>-)))
import Control.Functor.Bindable (Bindable ((>>=)))
import Control.Functor.Extendable (Extendable ((=>>)))
import Control.Functor.Adjoint (Adjoint (phi, psi))

newtype Identity a = Identity a

instance Covariant Identity where
        f <$> Identity x = Identity $ f x

instance Applicative Identity where
        Identity f <*> Identity x = Identity $ f x

instance Pointable Identity where
        point = Identity

instance Extractable Identity where
        extract (Identity x) = x

instance Traversable Identity where
        Identity x ->> f = Identity <$> f x

instance Distributive Identity where
        x >>- f = Identity $ extract . f <$> x

instance Bindable Identity where
        Identity x >>= f = f x

instance Extendable Identity where
        x =>> f = Identity . f $ x

instance Adjoint Identity Identity where
        phi f = Identity . f . Identity
        psi f = extract . extract . comap f