mtl-evil-instances (empty) → 0.1
raw patch · 5 files changed
+264/−0 lines, 5 filesdep +basedep +monad-controldep +mtlsetup-changed
Dependencies added: base, monad-control, mtl, transformers, transformers-base
Files
- CONTRIBUTORS +1/−0
- LICENSE +2/−0
- Setup.hs +2/−0
- mtl-evil-instances.cabal +68/−0
- src/Control/Monad/Instances/Evil.hs +191/−0
+ CONTRIBUTORS view
@@ -0,0 +1,1 @@+Shane O'Brien <shane@duairc.com>
+ LICENSE view
@@ -0,0 +1,2 @@+may the last IP lawyer be hung+with the guts of the last cop
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mtl-evil-instances.cabal view
@@ -0,0 +1,68 @@+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.Overlapping", 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.Overlapping".+ .+ 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.Overlapping", 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, than 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
+ src/Control/Monad/Instances/Evil.hs view
@@ -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