1{-# LANGUAGE CPP #-} 2#if __GLASGOW_HASKELL__ >= 700 3{-# LANGUAGE DeriveDataTypeable #-} 4#endif 5#if __GLASGOW_HASKELL__ >= 702 6{-# LANGUAGE DeriveGeneric #-} 7{-# LANGUAGE Trustworthy #-} 8#endif 9#if __GLASGOW_HASKELL__ >= 706 10{-# LANGUAGE PolyKinds #-} 11#endif 12#if __GLASGOW_HASKELL__ >= 708 13{-# LANGUAGE AutoDeriveTypeable #-} 14{-# LANGUAGE DataKinds #-} 15#endif 16#if MIN_VERSION_base(4,7,0) 17-- We need to implement bitSize for the Bits instance, but it's deprecated. 18{-# OPTIONS_GHC -fno-warn-deprecations #-} 19#endif 20----------------------------------------------------------------------------- 21-- | 22-- Module : Data.Functor.Identity 23-- Copyright : (c) Andy Gill 2001, 24-- (c) Oregon Graduate Institute of Science and Technology 2001 25-- License : BSD-style (see the file LICENSE) 26-- 27-- Maintainer : ross@soi.city.ac.uk 28-- Stability : experimental 29-- Portability : portable 30-- 31-- The identity functor and monad. 32-- 33-- This trivial type constructor serves two purposes: 34-- 35-- * It can be used with functions parameterized by functor or monad classes. 36-- 37-- * It can be used as a base monad to which a series of monad 38-- transformers may be applied to construct a composite monad. 39-- Most monad transformer modules include the special case of 40-- applying the transformer to 'Identity'. For example, @State s@ 41-- is an abbreviation for @StateT s 'Identity'@. 42----------------------------------------------------------------------------- 43 44module Data.Functor.Identity ( 45 Identity(..), 46 ) where 47 48import Data.Bits 49import Control.Applicative 50import Control.Arrow (Arrow((***))) 51import Control.Monad.Fix 52#if MIN_VERSION_base(4,4,0) 53import Control.Monad.Zip (MonadZip(mzipWith, munzip)) 54#endif 55import Data.Foldable (Foldable(foldMap)) 56import Data.Monoid (Monoid(mempty, mappend)) 57import Data.String (IsString(fromString)) 58import Data.Traversable (Traversable(traverse)) 59#if __GLASGOW_HASKELL__ >= 700 60import Data.Data 61#endif 62import Data.Ix (Ix(..)) 63import Foreign (Storable(..), castPtr) 64#if __GLASGOW_HASKELL__ >= 702 65import GHC.Generics 66#endif 67 68-- | Identity functor and monad. (a non-strict monad) 69newtype Identity a = Identity { runIdentity :: a } 70 deriving ( Eq, Ord 71#if __GLASGOW_HASKELL__ >= 700 72 , Data, Typeable 73#endif 74#if __GLASGOW_HASKELL__ >= 702 75 , Generic 76#endif 77#if __GLASGOW_HASKELL__ >= 706 78 , Generic1 79#endif 80 ) 81 82instance (Bits a) => Bits (Identity a) where 83 Identity x .&. Identity y = Identity (x .&. y) 84 Identity x .|. Identity y = Identity (x .|. y) 85 xor (Identity x) (Identity y) = Identity (xor x y) 86 complement (Identity x) = Identity (complement x) 87 shift (Identity x) i = Identity (shift x i) 88 rotate (Identity x) i = Identity (rotate x i) 89 setBit (Identity x) i = Identity (setBit x i) 90 clearBit (Identity x) i = Identity (clearBit x i) 91 shiftL (Identity x) i = Identity (shiftL x i) 92 shiftR (Identity x) i = Identity (shiftR x i) 93 rotateL (Identity x) i = Identity (rotateL x i) 94 rotateR (Identity x) i = Identity (rotateR x i) 95 testBit (Identity x) i = testBit x i 96 bitSize (Identity x) = bitSize x 97 isSigned (Identity x) = isSigned x 98 bit i = Identity (bit i) 99#if MIN_VERSION_base(4,5,0) 100 unsafeShiftL (Identity x) i = Identity (unsafeShiftL x i) 101 unsafeShiftR (Identity x) i = Identity (unsafeShiftR x i) 102 popCount (Identity x) = popCount x 103#endif 104#if MIN_VERSION_base(4,7,0) 105 zeroBits = Identity zeroBits 106 bitSizeMaybe (Identity x) = bitSizeMaybe x 107#endif 108 109instance (Bounded a) => Bounded (Identity a) where 110 minBound = Identity minBound 111 maxBound = Identity maxBound 112 113instance (Enum a) => Enum (Identity a) where 114 succ (Identity x) = Identity (succ x) 115 pred (Identity x) = Identity (pred x) 116 toEnum i = Identity (toEnum i) 117 fromEnum (Identity x) = fromEnum x 118 enumFrom (Identity x) = map Identity (enumFrom x) 119 enumFromThen (Identity x) (Identity y) = map Identity (enumFromThen x y) 120 enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y) 121 enumFromThenTo (Identity x) (Identity y) (Identity z) = 122 map Identity (enumFromThenTo x y z) 123 124#if MIN_VERSION_base(4,7,0) 125instance (FiniteBits a) => FiniteBits (Identity a) where 126 finiteBitSize (Identity x) = finiteBitSize x 127#endif 128 129instance (Floating a) => Floating (Identity a) where 130 pi = Identity pi 131 exp (Identity x) = Identity (exp x) 132 log (Identity x) = Identity (log x) 133 sqrt (Identity x) = Identity (sqrt x) 134 sin (Identity x) = Identity (sin x) 135 cos (Identity x) = Identity (cos x) 136 tan (Identity x) = Identity (tan x) 137 asin (Identity x) = Identity (asin x) 138 acos (Identity x) = Identity (acos x) 139 atan (Identity x) = Identity (atan x) 140 sinh (Identity x) = Identity (sinh x) 141 cosh (Identity x) = Identity (cosh x) 142 tanh (Identity x) = Identity (tanh x) 143 asinh (Identity x) = Identity (asinh x) 144 acosh (Identity x) = Identity (acosh x) 145 atanh (Identity x) = Identity (atanh x) 146 Identity x ** Identity y = Identity (x ** y) 147 logBase (Identity x) (Identity y) = Identity (logBase x y) 148 149instance (Fractional a) => Fractional (Identity a) where 150 Identity x / Identity y = Identity (x / y) 151 recip (Identity x) = Identity (recip x) 152 fromRational r = Identity (fromRational r) 153 154instance (IsString a) => IsString (Identity a) where 155 fromString s = Identity (fromString s) 156 157instance (Ix a) => Ix (Identity a) where 158 range (Identity x, Identity y) = map Identity (range (x, y)) 159 index (Identity x, Identity y) (Identity i) = index (x, y) i 160 inRange (Identity x, Identity y) (Identity e) = inRange (x, y) e 161 rangeSize (Identity x, Identity y) = rangeSize (x, y) 162 163instance (Integral a) => Integral (Identity a) where 164 quot (Identity x) (Identity y) = Identity (quot x y) 165 rem (Identity x) (Identity y) = Identity (rem x y) 166 div (Identity x) (Identity y) = Identity (div x y) 167 mod (Identity x) (Identity y) = Identity (mod x y) 168 quotRem (Identity x) (Identity y) = (Identity *** Identity) (quotRem x y) 169 divMod (Identity x) (Identity y) = (Identity *** Identity) (divMod x y) 170 toInteger (Identity x) = toInteger x 171 172instance (Monoid a) => Monoid (Identity a) where 173 mempty = Identity mempty 174 mappend (Identity x) (Identity y) = Identity (mappend x y) 175 176instance (Num a) => Num (Identity a) where 177 Identity x + Identity y = Identity (x + y) 178 Identity x - Identity y = Identity (x - y) 179 Identity x * Identity y = Identity (x * y) 180 negate (Identity x) = Identity (negate x) 181 abs (Identity x) = Identity (abs x) 182 signum (Identity x) = Identity (signum x) 183 fromInteger n = Identity (fromInteger n) 184 185instance (Real a) => Real (Identity a) where 186 toRational (Identity x) = toRational x 187 188instance (RealFloat a) => RealFloat (Identity a) where 189 floatRadix (Identity x) = floatRadix x 190 floatDigits (Identity x) = floatDigits x 191 floatRange (Identity x) = floatRange x 192 decodeFloat (Identity x) = decodeFloat x 193 exponent (Identity x) = exponent x 194 isNaN (Identity x) = isNaN x 195 isInfinite (Identity x) = isInfinite x 196 isDenormalized (Identity x) = isDenormalized x 197 isNegativeZero (Identity x) = isNegativeZero x 198 isIEEE (Identity x) = isIEEE x 199 significand (Identity x) = significand (Identity x) 200 scaleFloat s (Identity x) = Identity (scaleFloat s x) 201 encodeFloat m n = Identity (encodeFloat m n) 202 atan2 (Identity x) (Identity y) = Identity (atan2 x y) 203 204instance (RealFrac a) => RealFrac (Identity a) where 205 properFraction (Identity x) = (id *** Identity) (properFraction x) 206 truncate (Identity x) = truncate x 207 round (Identity x) = round x 208 ceiling (Identity x) = ceiling x 209 floor (Identity x) = floor x 210 211instance (Storable a) => Storable (Identity a) where 212 sizeOf (Identity x) = sizeOf x 213 alignment (Identity x) = alignment x 214 peekElemOff p i = fmap Identity (peekElemOff (castPtr p) i) 215 pokeElemOff p i (Identity x) = pokeElemOff (castPtr p) i x 216 peekByteOff p i = fmap Identity (peekByteOff p i) 217 pokeByteOff p i (Identity x) = pokeByteOff p i x 218 peek p = fmap runIdentity (peek (castPtr p)) 219 poke p (Identity x) = poke (castPtr p) x 220 221-- These instances would be equivalent to the derived instances of the 222-- newtype if the field were removed. 223 224instance (Read a) => Read (Identity a) where 225 readsPrec d = readParen (d > 10) $ \ r -> 226 [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s] 227 228instance (Show a) => Show (Identity a) where 229 showsPrec d (Identity x) = showParen (d > 10) $ 230 showString "Identity " . showsPrec 11 x 231 232-- --------------------------------------------------------------------------- 233-- Identity instances for Functor and Monad 234 235instance Functor Identity where 236 fmap f m = Identity (f (runIdentity m)) 237 238instance Foldable Identity where 239 foldMap f (Identity x) = f x 240 241instance Traversable Identity where 242 traverse f (Identity x) = Identity <$> f x 243 244instance Applicative Identity where 245 pure a = Identity a 246 Identity f <*> Identity x = Identity (f x) 247 248instance Monad Identity where 249 return a = Identity a 250 m >>= k = k (runIdentity m) 251 252instance MonadFix Identity where 253 mfix f = Identity (fix (runIdentity . f)) 254 255#if MIN_VERSION_base(4,4,0) 256instance MonadZip Identity where 257 mzipWith f (Identity x) (Identity y) = Identity (f x y) 258 munzip (Identity (a, b)) = (Identity a, Identity b) 259#endif 260