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, 259 insertions, 0 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 new file mode 100644 index 0000000000..940e4e470f --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/transformers/legacy/pre709/Data/Functor/Identity.hs @@ -0,0 +1,259 @@ +{-# 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 |