Skip to content
Snippets Groups Projects
Commit 873c3981 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel :man_dancing:
Browse files

{Data,Generic(1),MonadZip} instances for Identity

These instances were missed when the identity functor was added to
the `base` package (re #9664).

(cherry picked from commit 1f60d635)
parent 20ccf726
No related merge requests found
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
......@@ -33,14 +34,17 @@ module Data.Functor.Identity (
) where
import Control.Monad.Fix
import Control.Monad.Zip
import Data.Coerce
import Data.Data (Data)
import Data.Foldable
import GHC.Generics (Generic, Generic1)
-- | Identity functor and monad. (a non-strict monad)
--
-- @since 4.8.0.0
newtype Identity a = Identity { runIdentity :: a }
deriving (Eq, Ord, Traversable)
deriving (Eq, Ord, Data, Traversable, Generic, Generic1)
-- | This instance would be equivalent to the derived instances of the
-- 'Identity' newtype if the 'runIdentity' field were removed
......@@ -89,6 +93,9 @@ instance Monad Identity where
instance MonadFix Identity where
mfix f = Identity (fix (runIdentity . f))
instance MonadZip Identity where
mzipWith = coerce
munzip = coerce
-- | Internal (non-exported) 'Coercible' helper for 'elem'
--
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment