1{-# LANGUAGE CPP #-} 2 3#ifndef HASKELL98 4{-# LANGUAGE DeriveDataTypeable #-} 5{-# LANGUAGE EmptyDataDecls #-} 6{-# LANGUAGE FlexibleContexts #-} 7{-# LANGUAGE KindSignatures #-} 8{-# LANGUAGE StandaloneDeriving #-} 9{-# LANGUAGE TypeFamilies #-} 10{-# LANGUAGE TypeOperators #-} 11 12# if __GLASGOW_HASKELL__ >= 702 13{-# LANGUAGE Trustworthy #-} 14# endif 15 16# if __GLASGOW_HASKELL__ >= 706 17{-# LANGUAGE PolyKinds #-} 18# endif 19 20# if __GLASGOW_HASKELL__ >= 708 21{-# LANGUAGE DataKinds #-} 22# endif 23#endif 24 25{-# OPTIONS_GHC -fno-warn-deprecations #-} 26----------------------------------------------------------------------------- 27-- | 28-- Module : Control.Monad.Trans.Instances 29-- Copyright : (C) 2012-16 Edward Kmett 30-- License : BSD-style (see the file LICENSE) 31-- Maintainer : Edward Kmett <ekmett@gmail.com> 32-- Stability : provisional 33-- Portability : portable 34-- 35-- Backports orphan instances which are not provided by other modules in 36-- @transformers-compat@. 37---------------------------------------------------------------------------- 38module Control.Monad.Trans.Instances () where 39 40#ifndef MIN_VERSION_base 41#define MIN_VERSION_base(a,b,c) 1 42#endif 43 44#ifndef MIN_VERSION_transformers 45#define MIN_VERSION_transformers(a,b,c) 1 46#endif 47 48import Control.Applicative.Backwards (Backwards(..)) 49import Control.Applicative.Lift (Lift(..)) 50import qualified Control.Monad.Fail as Fail (MonadFail(..)) 51import Control.Monad.IO.Class (MonadIO) 52import Control.Monad.Trans.Accum (AccumT(..)) 53import Control.Monad.Trans.Class (MonadTrans(..)) 54import Control.Monad.Trans.Cont (ContT(..)) 55import Control.Monad.Trans.Error (Error(..), ErrorT(..)) 56import Control.Monad.Trans.Except (ExceptT(..)) 57import Control.Monad.Trans.Identity (IdentityT(..)) 58import Control.Monad.Trans.List (ListT(..), mapListT) 59import Control.Monad.Trans.Maybe (MaybeT(..)) 60import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..)) 61import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(..)) 62import Control.Monad.Trans.Reader (ReaderT(..)) 63import Control.Monad.Trans.Select (SelectT(..)) 64import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(..)) 65import qualified Control.Monad.Trans.State.Strict as Strict (StateT(..)) 66import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..)) 67import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(..)) 68import Data.Functor.Classes 69import Data.Functor.Compose (Compose(..)) 70import Data.Functor.Constant (Constant(..)) 71import Data.Functor.Identity (Identity(..)) 72import Data.Functor.Product (Product(..)) 73import Data.Functor.Reverse (Reverse(..)) 74import Data.Functor.Sum (Sum(..)) 75 76import Control.Applicative 77import Control.Arrow (Arrow((***))) 78import Control.Monad (MonadPlus(..), liftM) 79import Control.Monad.Fix (MonadFix(..)) 80import Data.Bits 81import Data.Foldable (Foldable(..)) 82import Data.Ix (Ix(..)) 83import Data.Maybe (fromMaybe) 84import Data.Monoid (Monoid(..)) 85import Data.String (IsString(fromString)) 86import Data.Traversable (Traversable(..)) 87import Foreign (Storable(..), castPtr) 88 89#if MIN_VERSION_base(4,4,0) 90import Control.Monad.Zip (MonadZip(..)) 91#endif 92 93#if MIN_VERSION_base(4,7,0) 94import Data.Proxy (Proxy(..)) 95#endif 96 97#if MIN_VERSION_base(4,8,0) 98import Data.Bifunctor (Bifunctor(..)) 99#endif 100 101#if MIN_VERSION_base(4,9,0) 102import qualified Data.Semigroup as Semigroup (Semigroup(..)) 103#endif 104 105#if MIN_VERSION_base(4,10,0) 106import Data.Bifoldable (Bifoldable(..)) 107import Data.Bitraversable (Bitraversable(..)) 108#endif 109 110#ifndef HASKELL98 111import Data.Data (Data) 112import Data.Typeable 113 114# ifdef GENERIC_DERIVING 115import Generics.Deriving.Base 116# elif __GLASGOW_HASKELL__ >= 702 117import GHC.Generics 118# endif 119#endif 120 121#if !(MIN_VERSION_transformers(0,3,0)) 122-- Foldable/Traversable instances 123instance (Foldable f) => Foldable (ErrorT e f) where 124 foldMap f (ErrorT a) = foldMap (either (const mempty) f) a 125 126instance (Traversable f) => Traversable (ErrorT e f) where 127 traverse f (ErrorT a) = 128 ErrorT <$> traverse (either (pure . Left) (fmap Right . f)) a 129 130instance (Foldable f) => Foldable (IdentityT f) where 131 foldMap f (IdentityT a) = foldMap f a 132 133instance (Traversable f) => Traversable (IdentityT f) where 134 traverse f (IdentityT a) = IdentityT <$> traverse f a 135 136instance (Foldable f) => Foldable (ListT f) where 137 foldMap f (ListT a) = foldMap (foldMap f) a 138 139instance (Traversable f) => Traversable (ListT f) where 140 traverse f (ListT a) = ListT <$> traverse (traverse f) a 141 142instance (Foldable f) => Foldable (MaybeT f) where 143 foldMap f (MaybeT a) = foldMap (foldMap f) a 144 145instance (Traversable f) => Traversable (MaybeT f) where 146 traverse f (MaybeT a) = MaybeT <$> traverse (traverse f) a 147 148instance (Foldable f) => Foldable (Lazy.WriterT w f) where 149 foldMap f = foldMap (f . fst) . Lazy.runWriterT 150 151instance (Traversable f) => Traversable (Lazy.WriterT w f) where 152 traverse f = fmap Lazy.WriterT . traverse f' . Lazy.runWriterT where 153 f' (a, b) = fmap (\ c -> (c, b)) (f a) 154 155instance (Foldable f) => Foldable (Strict.WriterT w f) where 156 foldMap f = foldMap (f . fst) . Strict.runWriterT 157 158instance (Traversable f) => Traversable (Strict.WriterT w f) where 159 traverse f = fmap Strict.WriterT . traverse f' . Strict.runWriterT where 160 f' (a, b) = fmap (\ c -> (c, b)) (f a) 161 162-- MonadFix instances for IdentityT and MaybeT 163instance (MonadFix m) => MonadFix (IdentityT m) where 164 mfix f = IdentityT (mfix (runIdentityT . f)) 165 166instance (MonadFix m) => MonadFix (MaybeT m) where 167 mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb)) 168 where bomb = error "mfix (MaybeT): inner computation returned Nothing" 169 170# if !(MIN_VERSION_base(4,9,0)) 171-- Monad instances for Product 172instance (Monad f, Monad g) => Monad (Product f g) where 173 return x = Pair (return x) (return x) 174 Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f) 175 where 176 fstP (Pair a _) = a 177 sndP (Pair _ b) = b 178 179instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where 180 mzero = Pair mzero mzero 181 Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2) 182 183instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where 184 mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f)) 185 where 186 fstP (Pair a _) = a 187 sndP (Pair _ b) = b 188# endif 189#endif 190 191#if !(MIN_VERSION_transformers(0,4,0)) 192-- Alternative IO instance 193# if !(MIN_VERSION_base(4,9,0)) 194-- The version bounds of transformers prior to 0.4.0.0 should prevent this 195-- instance from being compiled on base-4.8.0.0 and later, but we'll put 196-- a check here just to be safe. 197instance Alternative IO where 198 empty = mzero 199 (<|>) = mplus 200# endif 201#endif 202 203#if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,4,3)) 204-- transformers-0.4-specific Eq1, Ord1, Read1, and Show1 instances for Const 205instance (Eq a) => Eq1 (Const a) where 206 eq1 (Const x) (Const y) = x == y 207instance (Ord a) => Ord1 (Const a) where 208 compare1 (Const x) (Const y) = compare x y 209instance (Read a) => Read1 (Const a) where 210 readsPrec1 = readsData $ readsUnary "Const" Const 211instance (Show a) => Show1 (Const a) where 212 showsPrec1 d (Const x) = showsUnary "Const" d x 213#endif 214 215#if !(MIN_VERSION_transformers(0,5,0)) \ 216 || (MIN_VERSION_transformers(0,5,0) && !(MIN_VERSION_base(4,9,0))) 217-- MonadFail instances 218instance (Fail.MonadFail m) => Fail.MonadFail (ContT r m) where 219 fail msg = ContT $ \ _ -> Fail.fail msg 220 {-# INLINE fail #-} 221 222instance (Monad m, Error e) => Fail.MonadFail (ErrorT e m) where 223 fail msg = ErrorT $ return (Left (strMsg msg)) 224 225instance (Fail.MonadFail m) => Fail.MonadFail (IdentityT m) where 226 fail msg = IdentityT $ Fail.fail msg 227 {-# INLINE fail #-} 228 229instance (Monad m) => Fail.MonadFail (ListT m) where 230 fail _ = ListT $ return [] 231 {-# INLINE fail #-} 232 233instance (Monad m) => Fail.MonadFail (MaybeT m) where 234 fail _ = MaybeT (return Nothing) 235 {-# INLINE fail #-} 236 237instance (Fail.MonadFail m) => Fail.MonadFail (ReaderT r m) where 238 fail msg = lift (Fail.fail msg) 239 {-# INLINE fail #-} 240 241instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (Lazy.RWST r w s m) where 242 fail msg = Lazy.RWST $ \ _ _ -> Fail.fail msg 243 {-# INLINE fail #-} 244 245instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (Strict.RWST r w s m) where 246 fail msg = Strict.RWST $ \ _ _ -> Fail.fail msg 247 {-# INLINE fail #-} 248 249instance (Fail.MonadFail m) => Fail.MonadFail (Lazy.StateT s m) where 250 fail str = Lazy.StateT $ \ _ -> Fail.fail str 251 {-# INLINE fail #-} 252 253instance (Fail.MonadFail m) => Fail.MonadFail (Strict.StateT s m) where 254 fail str = Strict.StateT $ \ _ -> Fail.fail str 255 {-# INLINE fail #-} 256 257instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (Lazy.WriterT w m) where 258 fail msg = Lazy.WriterT $ Fail.fail msg 259 {-# INLINE fail #-} 260 261instance (Monoid w, Fail.MonadFail m) => Fail.MonadFail (Strict.WriterT w m) where 262 fail msg = Strict.WriterT $ Fail.fail msg 263 {-# INLINE fail #-} 264 265# if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_base(4,9,0)) 266instance (Fail.MonadFail m) => Fail.MonadFail (ExceptT e m) where 267 fail = ExceptT . Fail.fail 268 {-# INLINE fail #-} 269# endif 270 271# if MIN_VERSION_transformers(0,5,3) && !(MIN_VERSION_base(4,9,0)) 272instance (Monoid w, Functor m, Fail.MonadFail m) => Fail.MonadFail (AccumT w m) where 273 fail msg = AccumT $ const (Fail.fail msg) 274 {-# INLINE fail #-} 275 276instance (Fail.MonadFail m) => Fail.MonadFail (SelectT r m) where 277 fail msg = lift (Fail.fail msg) 278 {-# INLINE fail #-} 279# endif 280#endif 281 282#if !(MIN_VERSION_transformers(0,5,0)) 283-- Monoid Constant instance 284instance (Monoid a) => Monoid (Constant a b) where 285 mempty = Constant mempty 286 Constant x `mappend` Constant y = Constant (x `mappend` y) 287 288-- MonadZip instances 289# if MIN_VERSION_base(4,4,0) 290instance (MonadZip m) => MonadZip (IdentityT m) where 291 mzipWith f (IdentityT a) (IdentityT b) = IdentityT (mzipWith f a b) 292 293instance (MonadZip m) => MonadZip (ListT m) where 294 mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b 295 296instance (MonadZip m) => MonadZip (MaybeT m) where 297 mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b 298 299instance (MonadZip m) => MonadZip (ReaderT r m) where 300 mzipWith f (ReaderT m) (ReaderT n) = ReaderT $ \ a -> 301 mzipWith f (m a) (n a) 302 303instance (Monoid w, MonadZip m) => MonadZip (Lazy.WriterT w m) where 304 mzipWith f (Lazy.WriterT x) (Lazy.WriterT y) = Lazy.WriterT $ 305 mzipWith (\ ~(a, w) ~(b, w') -> (f a b, w `mappend` w')) x y 306 307instance (Monoid w, MonadZip m) => MonadZip (Strict.WriterT w m) where 308 mzipWith f (Strict.WriterT x) (Strict.WriterT y) = Strict.WriterT $ 309 mzipWith (\ (a, w) (b, w') -> (f a b, w `mappend` w')) x y 310 311# if !(MIN_VERSION_base(4,8,0)) 312instance MonadZip Identity where 313 mzipWith f (Identity x) (Identity y) = Identity (f x y) 314 munzip (Identity (a, b)) = (Identity a, Identity b) 315# endif 316 317# if !(MIN_VERSION_base(4,9,0)) 318instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where 319 mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2) 320# endif 321# endif 322 323# if MIN_VERSION_base(4,8,0) 324-- Bifunctor Constant instance 325instance Bifunctor Constant where 326 first f (Constant x) = Constant (f x) 327 second _ (Constant x) = Constant x 328# else 329-- Monoid Identity instance 330instance (Monoid a) => Monoid (Identity a) where 331 mempty = Identity mempty 332 mappend (Identity x) (Identity y) = Identity (mappend x y) 333# endif 334 335# ifndef HASKELL98 336-- Typeable instances 337# if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 338deriving instance Typeable Backwards 339deriving instance Typeable Constant 340deriving instance Typeable ContT 341deriving instance Typeable ErrorT 342deriving instance Typeable IdentityT 343deriving instance Typeable Lift 344deriving instance Typeable ListT 345deriving instance Typeable MaybeT 346deriving instance Typeable MonadTrans 347deriving instance Typeable Lazy.RWST 348deriving instance Typeable Strict.RWST 349deriving instance Typeable ReaderT 350deriving instance Typeable Reverse 351deriving instance Typeable Lazy.StateT 352deriving instance Typeable Strict.StateT 353 354# if !(MIN_VERSION_base(4,9,0)) 355deriving instance Typeable Compose 356deriving instance Typeable MonadIO 357deriving instance Typeable Product 358# endif 359# endif 360 361-- Identity instances 362# if !(MIN_VERSION_base(4,8,0)) 363deriving instance Typeable1 Identity 364deriving instance Data a => Data (Identity a) 365# if __GLASGOW_HASKELL__ >= 708 366deriving instance Typeable 'Identity 367# endif 368# endif 369 370# if !(MIN_VERSION_base(4,9,0)) 371# if __GLASGOW_HASKELL__ >= 708 372-- Data instances for Compose and Product 373deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a) 374 => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *)) 375deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a) 376 => Data (Product (f :: * -> *) (g :: * -> *) (a :: *)) 377 378# if MIN_VERSION_transformers(0,4,0) 379-- Typeable/Data instances for Sum 380-- These are also present in Data.Functor.Sum in transformers-compat, but only 381-- these are reachable if using @transformers-0.4.0.0@ 382deriving instance Typeable Sum 383deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a) 384 => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *)) 385# endif 386# endif 387# endif 388# endif 389#endif 390 391#if !(MIN_VERSION_transformers(0,5,1)) 392# if !(MIN_VERSION_base(4,8,0)) 393instance (Bounded a) => Bounded (Identity a) where 394 minBound = Identity minBound 395 maxBound = Identity maxBound 396 397instance (Enum a) => Enum (Identity a) where 398 succ (Identity x) = Identity (succ x) 399 pred (Identity x) = Identity (pred x) 400 toEnum i = Identity (toEnum i) 401 fromEnum (Identity x) = fromEnum x 402 enumFrom (Identity x) = map Identity (enumFrom x) 403 enumFromThen (Identity x) (Identity y) = map Identity (enumFromThen x y) 404 enumFromTo (Identity x) (Identity y) = map Identity (enumFromTo x y) 405 enumFromThenTo (Identity x) (Identity y) (Identity z) = 406 map Identity (enumFromThenTo x y z) 407 408instance (Ix a) => Ix (Identity a) where 409 range (Identity x, Identity y) = map Identity (range (x, y)) 410 index (Identity x, Identity y) (Identity i) = index (x, y) i 411 inRange (Identity x, Identity y) (Identity e) = inRange (x, y) e 412 rangeSize (Identity x, Identity y) = rangeSize (x, y) 413 414instance (Storable a) => Storable (Identity a) where 415 sizeOf (Identity x) = sizeOf x 416 alignment (Identity x) = alignment x 417 peekElemOff p i = fmap Identity (peekElemOff (castPtr p) i) 418 pokeElemOff p i (Identity x) = pokeElemOff (castPtr p) i x 419 peekByteOff p i = fmap Identity (peekByteOff p i) 420 pokeByteOff p i (Identity x) = pokeByteOff p i x 421 peek p = fmap runIdentity (peek (castPtr p)) 422 poke p (Identity x) = poke (castPtr p) x 423# endif 424#endif 425 426#if !(MIN_VERSION_transformers(0,5,3)) 427# if !(MIN_VERSION_base(4,9,0)) 428# if MIN_VERSION_base(4,7,0) 429-- Data.Proxy 430# if defined(TRANSFORMERS_FOUR) 431instance Eq1 Proxy where 432 eq1 _ _ = True 433 434instance Ord1 Proxy where 435 compare1 _ _ = EQ 436 437instance Show1 Proxy where 438 showsPrec1 _ _ = showString "Proxy" 439 440instance Read1 Proxy where 441 readsPrec1 d = 442 readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) 443# elif MIN_VERSION_transformers(0,5,0) 444instance Eq1 Proxy where 445 liftEq _ _ _ = True 446 447instance Ord1 Proxy where 448 liftCompare _ _ _ = EQ 449 450instance Show1 Proxy where 451 liftShowsPrec _ _ _ _ = showString "Proxy" 452 453instance Read1 Proxy where 454 liftReadsPrec _ _ d = 455 readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ]) 456# endif 457# endif 458# endif 459 460# if !(MIN_VERSION_base(4,8,0)) 461-- Data.Functor.Identity 462instance (Bits a) => Bits (Identity a) where 463 Identity x .&. Identity y = Identity (x .&. y) 464 Identity x .|. Identity y = Identity (x .|. y) 465 xor (Identity x) (Identity y) = Identity (xor x y) 466 complement (Identity x) = Identity (complement x) 467 shift (Identity x) i = Identity (shift x i) 468 rotate (Identity x) i = Identity (rotate x i) 469 setBit (Identity x) i = Identity (setBit x i) 470 clearBit (Identity x) i = Identity (clearBit x i) 471 shiftL (Identity x) i = Identity (shiftL x i) 472 shiftR (Identity x) i = Identity (shiftR x i) 473 rotateL (Identity x) i = Identity (rotateL x i) 474 rotateR (Identity x) i = Identity (rotateR x i) 475 testBit (Identity x) i = testBit x i 476 bitSize (Identity x) = bitSize x 477 isSigned (Identity x) = isSigned x 478 bit i = Identity (bit i) 479# if MIN_VERSION_base(4,5,0) 480 unsafeShiftL (Identity x) i = Identity (unsafeShiftL x i) 481 unsafeShiftR (Identity x) i = Identity (unsafeShiftR x i) 482 popCount (Identity x) = popCount x 483# endif 484# if MIN_VERSION_base(4,7,0) 485 zeroBits = Identity zeroBits 486 bitSizeMaybe (Identity x) = bitSizeMaybe x 487# endif 488 489# if MIN_VERSION_base(4,7,0) 490instance (FiniteBits a) => FiniteBits (Identity a) where 491 finiteBitSize (Identity x) = finiteBitSize x 492# endif 493 494instance (Floating a) => Floating (Identity a) where 495 pi = Identity pi 496 exp (Identity x) = Identity (exp x) 497 log (Identity x) = Identity (log x) 498 sqrt (Identity x) = Identity (sqrt x) 499 sin (Identity x) = Identity (sin x) 500 cos (Identity x) = Identity (cos x) 501 tan (Identity x) = Identity (tan x) 502 asin (Identity x) = Identity (asin x) 503 acos (Identity x) = Identity (acos x) 504 atan (Identity x) = Identity (atan x) 505 sinh (Identity x) = Identity (sinh x) 506 cosh (Identity x) = Identity (cosh x) 507 tanh (Identity x) = Identity (tanh x) 508 asinh (Identity x) = Identity (asinh x) 509 acosh (Identity x) = Identity (acosh x) 510 atanh (Identity x) = Identity (atanh x) 511 Identity x ** Identity y = Identity (x ** y) 512 logBase (Identity x) (Identity y) = Identity (logBase x y) 513 514instance (Fractional a) => Fractional (Identity a) where 515 Identity x / Identity y = Identity (x / y) 516 recip (Identity x) = Identity (recip x) 517 fromRational r = Identity (fromRational r) 518 519instance (IsString a) => IsString (Identity a) where 520 fromString s = Identity (fromString s) 521 522instance (Integral a) => Integral (Identity a) where 523 quot (Identity x) (Identity y) = Identity (quot x y) 524 rem (Identity x) (Identity y) = Identity (rem x y) 525 div (Identity x) (Identity y) = Identity (div x y) 526 mod (Identity x) (Identity y) = Identity (mod x y) 527 quotRem (Identity x) (Identity y) = (Identity *** Identity) (quotRem x y) 528 divMod (Identity x) (Identity y) = (Identity *** Identity) (divMod x y) 529 toInteger (Identity x) = toInteger x 530 531instance (Num a) => Num (Identity a) where 532 Identity x + Identity y = Identity (x + y) 533 Identity x - Identity y = Identity (x - y) 534 Identity x * Identity y = Identity (x * y) 535 negate (Identity x) = Identity (negate x) 536 abs (Identity x) = Identity (abs x) 537 signum (Identity x) = Identity (signum x) 538 fromInteger n = Identity (fromInteger n) 539 540instance (Real a) => Real (Identity a) where 541 toRational (Identity x) = toRational x 542 543instance (RealFloat a) => RealFloat (Identity a) where 544 floatRadix (Identity x) = floatRadix x 545 floatDigits (Identity x) = floatDigits x 546 floatRange (Identity x) = floatRange x 547 decodeFloat (Identity x) = decodeFloat x 548 exponent (Identity x) = exponent x 549 isNaN (Identity x) = isNaN x 550 isInfinite (Identity x) = isInfinite x 551 isDenormalized (Identity x) = isDenormalized x 552 isNegativeZero (Identity x) = isNegativeZero x 553 isIEEE (Identity x) = isIEEE x 554 significand (Identity x) = significand (Identity x) 555 scaleFloat s (Identity x) = Identity (scaleFloat s x) 556 encodeFloat m n = Identity (encodeFloat m n) 557 atan2 (Identity x) (Identity y) = Identity (atan2 x y) 558 559instance (RealFrac a) => RealFrac (Identity a) where 560 properFraction (Identity x) = (id *** Identity) (properFraction x) 561 truncate (Identity x) = truncate x 562 round (Identity x) = round x 563 ceiling (Identity x) = ceiling x 564 floor (Identity x) = floor x 565# endif 566 567# if MIN_VERSION_transformers(0,3,0) 568-- Data.Functor.Reverse 569instance (Monad m) => Monad (Reverse m) where 570 return a = Reverse (return a) 571 {-# INLINE return #-} 572 m >>= f = Reverse (getReverse m >>= getReverse . f) 573 {-# INLINE (>>=) #-} 574 fail msg = Reverse (fail msg) 575 {-# INLINE fail #-} 576 577instance (Fail.MonadFail m) => Fail.MonadFail (Reverse m) where 578 fail msg = Reverse (Fail.fail msg) 579 {-# INLINE fail #-} 580 581instance (MonadPlus m) => MonadPlus (Reverse m) where 582 mzero = Reverse mzero 583 {-# INLINE mzero #-} 584 Reverse x `mplus` Reverse y = Reverse (x `mplus` y) 585 {-# INLINE mplus #-} 586# endif 587#endif 588 589#if !(MIN_VERSION_transformers(0,5,4)) 590# if MIN_VERSION_base(4,10,0) 591instance Bifoldable Constant where 592 bifoldMap f _ (Constant a) = f a 593 {-# INLINE bifoldMap #-} 594 595instance Bitraversable Constant where 596 bitraverse f _ (Constant a) = Constant <$> f a 597 {-# INLINE bitraverse #-} 598# endif 599#endif 600 601#if !(MIN_VERSION_transformers(0,5,5)) 602# if MIN_VERSION_base(4,9,0) 603instance (Semigroup.Semigroup a) => Semigroup.Semigroup (Constant a b) where 604 Constant x <> Constant y = Constant (x Semigroup.<> y) 605 {-# INLINE (<>) #-} 606# endif 607 608instance (MonadFix m) => MonadFix (ListT m) where 609 mfix f = ListT $ mfix (runListT . f . head) >>= \ xs -> case xs of 610 [] -> return [] 611 x:_ -> liftM (x:) (runListT (mfix (mapListT (liftM tail) . f))) 612 {-# INLINE mfix #-} 613#endif 614 615-- Generic(1) instances 616#ifndef HASKELL98 617# if (!(MIN_VERSION_transformers(0,5,0)) && (__GLASGOW_HASKELL__ >= 702 || defined(GENERIC_DERIVING))) \ 618 || (MIN_VERSION_transformers(0,5,0) && __GLASGOW_HASKELL__ < 702 && defined(GENERIC_DERIVING)) 619 620# if !(MIN_VERSION_base(4,8,0)) 621instance Generic (Identity a) where 622 type Rep (Identity a) = D1 MDIdentity (C1 MCIdentity (S1 MSIdentity (Rec0 a))) 623 from (Identity x) = M1 (M1 (M1 (K1 x))) 624 to (M1 (M1 (M1 (K1 x)))) = Identity x 625 626instance Generic1 Identity where 627 type Rep1 Identity = D1 MDIdentity (C1 MCIdentity (S1 MSIdentity Par1)) 628 from1 (Identity x) = M1 (M1 (M1 (Par1 x))) 629 to1 (M1 (M1 (M1 x))) = Identity (unPar1 x) 630 631data MDIdentity 632data MCIdentity 633data MSIdentity 634 635instance Datatype MDIdentity where 636 datatypeName _ = "Identity" 637 moduleName _ = "Data.Functor.Identity" 638# if __GLASGOW_HASKELL__ >= 708 639 isNewtype _ = True 640# endif 641 642instance Constructor MCIdentity where 643 conName _ = "Identity" 644 conIsRecord _ = True 645 646instance Selector MSIdentity where 647 selName _ = "runIdentity" 648# endif 649 650# if !(MIN_VERSION_base(4,9,0)) 651-- Generic(1) instances for Compose 652instance Generic (Compose f g a) where 653 type Rep (Compose f g a) = 654 D1 MDCompose 655 (C1 MCCompose 656 (S1 MSCompose (Rec0 (f (g a))))) 657 from (Compose x) = M1 (M1 (M1 (K1 x))) 658 to (M1 (M1 (M1 (K1 x)))) = Compose x 659 660instance Functor f => Generic1 (Compose f g) where 661 type Rep1 (Compose f g) = 662 D1 MDCompose 663 (C1 MCCompose 664 (S1 MSCompose (f :.: Rec1 g))) 665 from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x)))) 666 to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x)) 667 668data MDCompose 669data MCCompose 670data MSCompose 671 672instance Datatype MDCompose where 673 datatypeName _ = "Compose" 674 moduleName _ = "Data.Functor.Compose" 675# if __GLASGOW_HASKELL__ >= 708 676 isNewtype _ = True 677# endif 678 679instance Constructor MCCompose where 680 conName _ = "Compose" 681 conIsRecord _ = True 682 683instance Selector MSCompose where 684 selName _ = "getCompose" 685 686-- Generic(1) instances for Product 687instance Generic (Product f g a) where 688 type Rep (Product f g a) = 689 D1 MDProduct 690 (C1 MCPair 691 (S1 NoSelector (Rec0 (f a)) :*: S1 NoSelector (Rec0 (g a)))) 692 from (Pair f g) = M1 (M1 (M1 (K1 f) :*: M1 (K1 g))) 693 to (M1 (M1 (M1 (K1 f) :*: M1 (K1 g)))) = Pair f g 694 695instance Generic1 (Product f g) where 696 type Rep1 (Product f g) = 697 D1 MDProduct 698 (C1 MCPair 699 (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g))) 700 from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g))) 701 to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g) 702 703data MDProduct 704data MCPair 705 706instance Datatype MDProduct where 707 datatypeName _ = "Product" 708 moduleName _ = "Data.Functor.Product" 709 710instance Constructor MCPair where 711 conName _ = "Pair" 712 713# if MIN_VERSION_transformers(0,4,0) 714-- Generic(1) instances for Sum 715-- These are also present in Data.Functor.Sum in transformers-compat, but only 716-- these are reachable if using @transformers-0.4.0.0@ or later 717instance Generic (Sum f g a) where 718 type Rep (Sum f g a) = 719 D1 MDSum (C1 MCInL (S1 NoSelector (Rec0 (f a))) 720 :+: C1 MCInR (S1 NoSelector (Rec0 (g a)))) 721 from (InL f) = M1 (L1 (M1 (M1 (K1 f)))) 722 from (InR g) = M1 (R1 (M1 (M1 (K1 g)))) 723 to (M1 (L1 (M1 (M1 (K1 f))))) = InL f 724 to (M1 (R1 (M1 (M1 (K1 g))))) = InR g 725 726instance Generic1 (Sum f g) where 727 type Rep1 (Sum f g) = 728 D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f)) 729 :+: C1 MCInR (S1 NoSelector (Rec1 g))) 730 from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f)))) 731 from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g)))) 732 to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f) 733 to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g) 734 735data MDSum 736data MCInL 737data MCInR 738 739instance Datatype MDSum where 740 datatypeName _ = "Sum" 741 moduleName _ = "Data.Functor.Sum" 742 743instance Constructor MCInL where 744 conName _ = "InL" 745 746instance Constructor MCInR where 747 conName _ = "InR" 748# endif 749# endif 750 751# endif 752#endif 753