{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 700
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE AutoDeriveTypeable #-}
{-# LANGUAGE DataKinds #-}
#endif
#if MIN_VERSION_base(4,7,0)
-- We need to implement bitSize for the Bits instance, but it's deprecated.
{-# OPTIONS_GHC -fno-warn-deprecations #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Data.Functor.Identity
-- Copyright : (c) Andy Gill 2001,
-- (c) Oregon Graduate Institute of Science and Technology 2001
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : ross@soi.city.ac.uk
-- Stability : experimental
-- Portability : portable
--
-- The identity functor and monad.
--
-- This trivial type constructor serves two purposes:
--
-- * It can be used with functions parameterized by functor or monad classes.
--
-- * It can be used as a base monad to which a series of monad
-- transformers may be applied to construct a composite monad.
-- Most monad transformer modules include the special case of
-- applying the transformer to 'Identity'. For example, @State s@
-- is an abbreviation for @StateT s 'Identity'@.
-----------------------------------------------------------------------------
module Data.Functor.Identity (
Identity(..),
) where
import Data.Bits
import Control.Applicative
import Control.Arrow (Arrow((***)))
import Control.Monad.Fix
#if MIN_VERSION_base(4,4,0)
import Control.Monad.Zip (MonadZip(mzipWith, munzip))
#endif
import Data.Foldable (Foldable(foldMap))
import Data.Monoid (Monoid(mempty, mappend))
import Data.String (IsString(fromString))
import Data.Traversable (Traversable(traverse))
#if __GLASGOW_HASKELL__ >= 700
import Data.Data
#endif
import Data.Ix (Ix(..))
import Foreign (Storable(..), castPtr)
#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
#endif
-- | Identity functor and monad. (a non-strict monad)
newtype Identity a = Identity { runIdentity :: a }
deriving ( Eq, Ord
#if __GLASGOW_HASKELL__ >= 700
, Data, Typeable
#endif
#if __GLASGOW_HASKELL__ >= 702
, Generic
#endif
#if __GLASGOW_HASKELL__ >= 706
, Generic1
#endif
)
instance (Bits a) => Bits (Identity a) where
Identity x .&. Identity y = Identity (x .&. y)
Identity x .|. Identity y = Identity (x .|. y)
xor (Identity x) (Identity y) = Identity (xor x y)
complement (Identity x) = Identity (complement x)
shift (Identity x) i = Identity (shift x i)
rotate (Identity x) i = Identity (rotate x i)
setBit (Identity x) i = Identity (setBit x i)
clearBit (Identity x) i = Identity (clearBit x i)
shiftL (Identity x) i = Identity (shiftL x i)
shiftR (Identity x) i = Identity (shiftR x i)
rotateL (Identity x) i = Identity (rotateL x i)
rotateR (Identity x) i = Identity (rotateR x i)
testBit (Identity x) i = testBit x i
bitSize (Identity x) = bitSize x
isSigned (Identity x) = isSigned x
bit i = Identity (bit i)
#if MIN_VERSION_base(4,5,0)
unsafeShiftL (Identity x) i = Identity (unsafeShiftL x i)
unsafeShiftR (Identity x) i = Identity (unsafeShiftR x i)
popCount (Identity x) = popCount x
#endif
#if MIN_VERSION_base(4,7,0)
zeroBits = Identity zeroBits
bitSizeMaybe (Identity x) = bitSizeMaybe x
#endif
instance (Bounded a) => Bounded (Identity a) where
minBound = Identity minBound
maxBound = Identity maxBound
instance (Enum a) => Enum (Identity a) where
succ (Identity x) = Identity (succ x)
pred (Identity x) = Identity (pred x)
toEnum i = Identity (toEnum i)
fromEnum (Identity x) = fromEnum x
enumFrom (Identity x) = map Identity (enumFrom x)
enumFromThen (Identity x) (Identity y) = map Identity (enumFromThen x y)
enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y)
enumFromThenTo (Identity x) (Identity y) (Identity z) =
map Identity (enumFromThenTo x y z)
#if MIN_VERSION_base(4,7,0)
instance (FiniteBits a) => FiniteBits (Identity a) where
finiteBitSize (Identity x) = finiteBitSize x
#endif
instance (Floating a) => Floating (Identity a) where
pi = Identity pi
exp (Identity x) = Identity (exp x)
log (Identity x) = Identity (log x)
sqrt (Identity x) = Identity (sqrt x)
sin (Identity x) = Identity (sin x)
cos (Identity x) = Identity (cos x)
tan (Identity x) = Identity (tan x)
asin (Identity x) = Identity (asin x)
acos (Identity x) = Identity (acos x)
atan (Identity x) = Identity (atan x)
sinh (Identity x) = Identity (sinh x)
cosh (Identity x) = Identity (cosh x)
tanh (Identity x) = Identity (tanh x)
asinh (Identity x) = Identity (asinh x)
acosh (Identity x) = Identity (acosh x)
atanh (Identity x) = Identity (atanh x)
Identity x ** Identity y = Identity (x ** y)
logBase (Identity x) (Identity y) = Identity (logBase x y)
instance (Fractional a) => Fractional (Identity a) where
Identity x / Identity y = Identity (x / y)
recip (Identity x) = Identity (recip x)
fromRational r = Identity (fromRational r)
instance (IsString a) => IsString (Identity a) where
fromString s = Identity (fromString s)
instance (Ix a) => Ix (Identity a) where
range (Identity x, Identity y) = map Identity (range (x, y))
index (Identity x, Identity y) (Identity i) = index (x, y) i
inRange (Identity x, Identity y) (Identity e) = inRange (x, y) e
rangeSize (Identity x, Identity y) = rangeSize (x, y)
instance (Integral a) => Integral (Identity a) where
quot (Identity x) (Identity y) = Identity (quot x y)
rem (Identity x) (Identity y) = Identity (rem x y)
div (Identity x) (Identity y) = Identity (div x y)
mod (Identity x) (Identity y) = Identity (mod x y)
quotRem (Identity x) (Identity y) = (Identity *** Identity) (quotRem x y)
divMod (Identity x) (Identity y) = (Identity *** Identity) (divMod x y)
toInteger (Identity x) = toInteger x
instance (Monoid a) => Monoid (Identity a) where
mempty = Identity mempty
mappend (Identity x) (Identity y) = Identity (mappend x y)
instance (Num a) => Num (Identity a) where
Identity x + Identity y = Identity (x + y)
Identity x - Identity y = Identity (x - y)
Identity x * Identity y = Identity (x * y)
negate (Identity x) = Identity (negate x)
abs (Identity x) = Identity (abs x)
signum (Identity x) = Identity (signum x)
fromInteger n = Identity (fromInteger n)
instance (Real a) => Real (Identity a) where
toRational (Identity x) = toRational x
instance (RealFloat a) => RealFloat (Identity a) where
floatRadix (Identity x) = floatRadix x
floatDigits (Identity x) = floatDigits x
floatRange (Identity x) = floatRange x
decodeFloat (Identity x) = decodeFloat x
exponent (Identity x) = exponent x
isNaN (Identity x) = isNaN x
isInfinite (Identity x) = isInfinite x
isDenormalized (Identity x) = isDenormalized x
isNegativeZero (Identity x) = isNegativeZero x
isIEEE (Identity x) = isIEEE x
significand (Identity x) = significand (Identity x)
scaleFloat s (Identity x) = Identity (scaleFloat s x)
encodeFloat m n = Identity (encodeFloat m n)
atan2 (Identity x) (Identity y) = Identity (atan2 x y)
instance (RealFrac a) => RealFrac (Identity a) where
properFraction (Identity x) = (id *** Identity) (properFraction x)
truncate (Identity x) = truncate x
round (Identity x) = round x
ceiling (Identity x) = ceiling x
floor (Identity x) = floor x
instance (Storable a) => Storable (Identity a) where
sizeOf (Identity x) = sizeOf x
alignment (Identity x) = alignment x
peekElemOff p i = fmap Identity (peekElemOff (castPtr p) i)
pokeElemOff p i (Identity x) = pokeElemOff (castPtr p) i x
peekByteOff p i = fmap Identity (peekByteOff p i)
pokeByteOff p i (Identity x) = pokeByteOff p i x
peek p = fmap runIdentity (peek (castPtr p))
poke p (Identity x) = poke (castPtr p) x
-- These instances would be equivalent to the derived instances of the
-- newtype if the field were removed.
instance (Read a) => Read (Identity a) where
readsPrec d = readParen (d > 10) $ \ r ->
[(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s]
instance (Show a) => Show (Identity a) where
showsPrec d (Identity x) = showParen (d > 10) $
showString "Identity " . showsPrec 11 x
-- ---------------------------------------------------------------------------
-- Identity instances for Functor and Monad
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))
#if MIN_VERSION_base(4,4,0)
instance MonadZip Identity where
mzipWith f (Identity x) (Identity y) = Identity (f x y)
munzip (Identity (a, b)) = (Identity a, Identity b)
#endif
