Permalink
Browse files

Initial commit, 0.1 release.

  • Loading branch information...
0 parents commit f0e5e1619da4835f8315c3e4f740eaf54d14a11f @duairc committed Mar 2, 2012
Showing with 269 additions and 0 deletions.
  1. +1 −0 .gitignore
  2. +1 −0 CONTRIBUTORS
  3. +2 −0 LICENSE
  4. +2 −0 Setup.hs
  5. +72 −0 mtl-evil-instances.cabal
  6. +191 −0 src/Control/Monad/Instances/Evil.hs
@@ -0,0 +1 @@
+dist/*
@@ -0,0 +1 @@
+Shane O'Brien <shane@duairc.com>
@@ -0,0 +1,2 @@
+may the last IP lawyer be hung
+with the guts of the last cop
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -0,0 +1,72 @@
+name: mtl-evil-instances
+version: 0.1
+synopsis: Instances for the mtl classes for all monad transformers.
+license: PublicDomain
+license-file: LICENSE
+author: Shane O'Brien
+maintainer: shane@duairc.com
+stability: Experimental
+category: Control
+cabal-version: >= 1.6
+build-type: Simple
+description:
+ WARNING: THIS PACKAGE IS EVIL. DO NOT USE IT!
+ .
+ It is common when defining a monad transformer to define instances for that
+ transformer for each class in the @mtl@ library, to allow easy composition
+ with the existing standard monad transformers. However, doing this is very
+ tedious, and actually unnecessary, given that most of these instances across
+ different transformers are identical, and can actually be expressed purely
+ in terms of @MonadTrans@, or @MonadTransControl@ (from the @monad-control@
+ package) for the more complicated classes.
+ .
+ The reason this is not generally done is because it requires the
+ @OverlappingInstances@ extension, which is generally considered evil.
+ However, it does actually work. If you define a monad transformer, and
+ instances for @MonadTrans@ and @MonadTransControl@, and import
+ "Control.Monad.Instances.Evil", your monad transformer will magically have
+ sensible instances for all the @mtl@ type classes. And if you don't like one
+ of the instances provided, you can always define your own instance, which
+ will override the \"default\" one provided by this package, because by the
+ rules for @OverlappingInstances@, your instance is more \"specific\" than
+ the one exported by "Control.Monad.Instances.Evil".
+ .
+ The main disadvantage of this is that errors in code using
+ @OverlappingInstances@ can result in some really strange error messages that
+ are not very helpful. The reason this is evil is because this places an
+ additional burden (of dealing with confusing error messages) not just on
+ those who use this package directly, but anybody who indirectly uses any
+ code that, somewhere down the line, imported
+ "Control.Monad.Instances.Evil", due to the \"viral\" nature of instances.
+ Also, if another person were to make a package very similar to this one, and
+ somebody ended up importing both code that used this package, and code that
+ used the other package, then neither of them would work anymore. This is the
+ problem with orphan instances.
+ .
+ If you absolutely insist on using this code, you should probably define
+ manual instances for the @mtl@ classes the hard way as well, to avoid this
+ kind of breakage (thus defeating the purpose of this package). Of course,
+ realistically, this package is for everyone who wishes to ignore all such
+ advice and do bad things anyway (including myself). This is my gift to you!
+
+
+extra-source-files:
+ CONTRIBUTORS
+
+Library
+ hs-source-dirs:
+ src
+
+ exposed-modules:
+ Control.Monad.Instances.Evil
+
+ build-depends:
+ base > 4 && < 5,
+ mtl > 2 && < 2.1,
+ monad-control > 0.3 && < 0.4,
+ transformers > 0.2 && < 0.3,
+ transformers-base > 0.1 && < 0.5
+
+source-repository head
+ type: git
+ location: git://github.com/duairc/mtl-evil-instances.git
@@ -0,0 +1,191 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-|
+
+This module exports several very overlapping instances for the type classes
+defined in the @mtl@ library, and should be used with caution, or not at all
+(see the package description). The instances are defined:
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadBase' b m) => 'MonadBase' b (t m)@
+
+ * @instance ('MonadTransControl' t, 'Monad' (t m), 'MonadCont' m) => 'MonadCont' (t m)@
+
+ * @instance ('MonadTransControl' t, 'Monad' (t m), 'MonadError' e m) => 'MonadError' e (t m)@
+
+ * @instance ('MonadTransControl' t, 'Monad' (t m), 'MonadFix' m) => 'MonadFix' (t m)@
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadIO' m) => 'MonadIO' (t m)@
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadReader' r m) => 'MonadReader' r (t m)@
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadRWS' r w s m) => 'MonadRWS' r w s (t m)@
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadState' s m) => 'MonadState' s (t m)@
+
+ * @instance ('MonadTrans' t, 'Monad' (t m), 'MonadWriter' w m) => 'MonadWriter' w (t m)@
+
+ * @instance ('MonadBaseControl' b m, 'MonadCont' b) => 'MonadCont' m@
+
+ * @instance ('MonadBaseControl' b m, 'MonadError' e b) => 'MonadError' e m@
+
+ * @instance ('MonadBaseControl' b m, 'MonadFix' b) => 'MonadFix' m@
+
+ * @instance ('MonadBase' b m, 'MonadIO' b) => 'MonadIO' m@
+
+ * @instance ('MonadBase' b m, 'MonadReader' r b) => 'MonadReader' r m@
+
+ * @instance ('MonadBase' b m, 'MonadRWS' r w s b) => 'MonadRWS' r w s m@
+
+ * @instance ('MonadBase' b m, 'MonadState' s b) => 'MonadState' s m@
+
+ * @instance ('MonadBase' b m, 'MonadWriter' w b) => 'MonadWriter' w m@
+
+Note that the following instance is not included, as currently it cannot be due to GHC bug #4259:
+
+ * @instance ('MonadTransControl' t, 'Monad' (t m), 'MonadBaseControl' b m) => 'MonadBaseControl' b (t m)@
+
+
+-}
+
+module Control.Monad.Instances.Evil
+ ()
+where
+
+import Control.Applicative (Applicative (..))
+import Control.Monad.Base (MonadBase (..))
+import Control.Monad.Cont.Class (MonadCont(..))
+import Control.Monad.Error.Class (MonadError (..))
+import Control.Monad.Fix (MonadFix (..), fix)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Reader.Class (MonadReader (..))
+import Control.Monad.RWS.Class (MonadRWS (..))
+import Control.Monad.State.Class (MonadState (..))
+import Control.Monad.Trans.Class (MonadTrans (..))
+import Control.Monad.Trans.Control
+ ( ComposeSt
+ , MonadBaseControl (..)
+ , MonadTransControl (..)
+ , Run
+ , control
+ , defaultLiftBaseWith
+ , defaultRestoreM
+ )
+import Control.Monad.Writer.Class (MonadWriter (..))
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Applicative (t m), Monad (t m), MonadBase b m) => MonadBase b (t m) where
+ liftBase = lift . liftBase
+
+
+------------------------------------------------------------------------------
+{- This doesn't work, see: http://hackage.haskell.org/trac/ghc/ticket/4259
+instance (MonadTransControl t, Monad (t m), MonadBaseControl b m) => MonadBaseControl b (t m) where
+ newtype StM (t m) a = StMT {unStMT :: ComposeSt t m a}
+ liftBaseWith = defaultLiftBaseWith StMT
+ restoreM = defaultRestoreM unStMT
+-}
+
+
+------------------------------------------------------------------------------
+instance (MonadTransControl t, Monad (t m), MonadCont m) => MonadCont (t m) where
+ callCC f = controlT $ \run -> callCC $ \c -> run . f $
+ \a -> lift (run (return a) >>= c)
+
+
+------------------------------------------------------------------------------
+instance (MonadBaseControl b m, MonadCont b) => MonadCont m where
+ callCC f = control $ \run -> callCC $ \c -> run . f $
+ \a -> liftBase (run (return a) >>= c)
+
+
+------------------------------------------------------------------------------
+instance (MonadTransControl t, Monad (t m), MonadError e m) => MonadError e (t m) where
+ throwError = lift . throwError
+ catchError t h = controlT $ \run -> catchError (run t) (\e -> run (h e))
+
+
+------------------------------------------------------------------------------
+instance (MonadBaseControl b m, MonadError e b) => MonadError e m where
+ throwError = liftBase . throwError
+ catchError t h = control $ \run -> catchError (run t) (\e -> run (h e))
+
+
+------------------------------------------------------------------------------
+instance (MonadTransControl t, Monad (t m), MonadFix m) => MonadFix (t m) where
+ mfix f = controlT $ \run -> mfix (\a -> run (restoreT (return a) >>= f))
+
+
+------------------------------------------------------------------------------
+instance (MonadBaseControl b m, MonadFix b) => MonadFix m where
+ mfix f = control $ \run -> mfix (\a -> run (restoreM a >>= f))
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Monad (t m), MonadIO m) => MonadIO (t m) where
+ liftIO = lift . liftIO
+
+
+------------------------------------------------------------------------------
+instance (MonadBase b m, MonadIO b) => MonadIO m where
+ liftIO = liftBase . liftIO
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Monad (t m), MonadReader r m) => MonadReader r (t m) where
+ ask = lift ask
+ local f m = m >>= lift . local f . return
+
+
+------------------------------------------------------------------------------
+instance (MonadBase b m, MonadReader r b) => MonadReader r m where
+ ask = liftBase ask
+ local f m = m >>= liftBase . local f . return
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Monad (t m), MonadRWS r w s m) => MonadRWS r w s (t m)
+
+
+------------------------------------------------------------------------------
+instance (MonadBase b m, MonadRWS r w s b) => MonadRWS r w s m
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Monad (t m), MonadState s m) => MonadState s (t m) where
+ get = lift get
+ put s = lift $ put s
+
+
+------------------------------------------------------------------------------
+instance (MonadBase b m, MonadState s b) => MonadState s m where
+ get = liftBase get
+ put s = liftBase $ put s
+
+
+------------------------------------------------------------------------------
+instance (MonadTrans t, Monad (t m), MonadWriter w m) => MonadWriter w (t m) where
+ tell w = lift $ tell w
+ listen m = m >>= lift . listen . return
+ pass m = m >>= lift . pass . return
+
+
+------------------------------------------------------------------------------
+instance (MonadBase b m, MonadWriter w b) => MonadWriter w m where
+ tell w = liftBase $ tell w
+ listen m = m >>= liftBase . listen . return
+ pass m = m >>= liftBase . pass . return
+
+
+------------------------------------------------------------------------------
+controlT
+ :: (MonadTransControl t, Monad (t m), Monad m)
+ => (Run t -> m (StT t a)) -> t m a
+controlT f = liftWith f >>= restoreT . return

0 comments on commit f0e5e16

Please sign in to comment.