diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs')
| -rw-r--r-- | third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs | 259 |
1 files changed, 0 insertions, 259 deletions
diff --git a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs deleted file mode 100644 index 940e4e470f..0000000000 --- a/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs +++ /dev/null @@ -1,259 +0,0 @@ -{-# 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 |