Merge pull request #100 from mossprescott/monaddeclare-instances

Make MonadDeclare more useful

src/Data/Swagger/Declare.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
 -- |
 -- Module:      Data.Swagger.Declare
 -- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
@@ -14,7 +15,19 @@ import Prelude ()
 import Prelude.Compat
 
 import Control.Monad
+import Control.Monad.Cont (ContT)
+import Control.Monad.List (ListT)
+import Control.Monad.Reader (ReaderT)
 import Control.Monad.Trans
+import Control.Monad.Trans.Except (ExceptT)
+import Control.Monad.Trans.Identity (IdentityT)
+import Control.Monad.Trans.Maybe (MaybeT)
+import Control.Monad.Trans.State.Lazy as Lazy
+import Control.Monad.Trans.State.Strict as Strict
+import Control.Monad.Trans.RWS.Lazy as Lazy
+import Control.Monad.Trans.RWS.Strict as Strict
+import Control.Monad.Trans.Writer.Lazy as Lazy
+import Control.Monad.Trans.Writer.Strict as Strict
 import Data.Functor.Identity
 import Data.Monoid
 
@@ -77,6 +90,13 @@ instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) whe
   declare d = DeclareT (\_ -> return (d, ()))
   look = DeclareT (\d -> return (mempty, d))
 
+-- | Lift a computation from the simple Declare monad.
+liftDeclare :: MonadDeclare d m => Declare d a -> m a
+liftDeclare da = do
+  (d', a) <- looks (runDeclare da)
+  declare d'
+  pure a
+
 -- | Retrieve a function of all the output so far.
 looks :: MonadDeclare d m => (d -> a) -> m a
 looks f = f <$> look
@@ -125,3 +145,56 @@ execDeclare m = runIdentity . execDeclareT m
 undeclare :: Monoid d => Declare d a -> a
 undeclare = runIdentity . undeclareT
 
+-- ---------------------------------------------------------------------------
+-- Instances for other mtl transformers
+--
+-- All of these instances need UndecidableInstances,
+-- because they do not satisfy the coverage condition.
+
+instance MonadDeclare d m => MonadDeclare d (ContT r m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (ExceptT e m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (ListT m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (ReaderT r m) where
+  declare = lift . declare
+  look = lift look
+
+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.RWST r w s m) where
+  declare = lift . declare
+  look = lift look
+
+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.RWST r w s m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (Lazy.StateT s m) where
+  declare = lift . declare
+  look = lift look
+
+instance MonadDeclare d m => MonadDeclare d (Strict.StateT s m) where
+  declare = lift . declare
+  look = lift look
+
+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.WriterT w m) where
+  declare = lift . declare
+  look = lift look
+
+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.WriterT w m) where
+  declare = lift . declare
+  look = lift look

swagger2.cabal

@@ -56,6 +56,7 @@ library
                      , template-haskell
                      , time
                      , transformers
+                     , transformers-compat >= 0.3
                      , unordered-containers
                      , vector
                      , uuid-types >=1.0.2 && <1.1