module Data.Functor.Identity (
Identity(..),
) where
import Data.Functor.Classes
import Control.Applicative
import Control.Monad.Fix
import Data.Foldable (Foldable(foldMap))
import Data.Traversable (Traversable(traverse))
newtype Identity a = Identity { runIdentity :: a }
deriving (Eq, Ord)
instance (Read a) => Read (Identity a) where
readsPrec = readsData $ readsUnary "Identity" Identity
instance (Show a) => Show (Identity a) where
showsPrec d (Identity x) = showsUnary "Identity" d x
instance Eq1 Identity where eq1 = (==)
instance Ord1 Identity where compare1 = compare
instance Read1 Identity where readsPrec1 = readsPrec
instance Show1 Identity where showsPrec1 = showsPrec
instance Functor Identity where
fmap f m = Identity (f (runIdentity m))
instance Foldable Identity where
foldMap f (Identity x) = f x
instance Traversable Identity where
traverse f (Identity x) = Identity <$> f x
instance Applicative Identity where
pure a = Identity a
Identity f <*> Identity x = Identity (f x)
instance Monad Identity where
return a = Identity a
m >>= k = k (runIdentity m)
instance MonadFix Identity where
mfix f = Identity (fix (runIdentity . f))