git.iko.soy/typeable/openapi3
on master help sign in
Merge pull request #100 from mossprescott/monaddeclare-instances

Make MonadDeclare more useful

commit04d76658b48d5920bfe7e40dbc9c342a672f723d authorNickolay Kudasov <fizruk@users.noreply.github.com> dateTue 25 Apr 2017, 21:57 (9 years ago) parent179ab5e0e46274
2 files changed+74
src/Data/Swagger/Declare.hs+73 swagger2.cabal+1
src/Data/Swagger/Declare.hs+73
@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleInstances #-}
33{-# LANGUAGE FunctionalDependencies #-}
44{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE UndecidableInstances #-}
56-- |
67-- Module: Data.Swagger.Declare
78-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
@@ -14,7 +15,19 @@ import Prelude ()
1415import Prelude.Compat
1516
1617import Control.Monad
18+import Control.Monad.Cont (ContT)
19+import Control.Monad.List (ListT)
20+import Control.Monad.Reader (ReaderT)
1721import Control.Monad.Trans
22+import Control.Monad.Trans.Except (ExceptT)
23+import Control.Monad.Trans.Identity (IdentityT)
24+import Control.Monad.Trans.Maybe (MaybeT)
25+import Control.Monad.Trans.State.Lazy as Lazy
26+import Control.Monad.Trans.State.Strict as Strict
27+import Control.Monad.Trans.RWS.Lazy as Lazy
28+import Control.Monad.Trans.RWS.Strict as Strict
29+import Control.Monad.Trans.Writer.Lazy as Lazy
30+import Control.Monad.Trans.Writer.Strict as Strict
1831import Data.Functor.Identity
1932import Data.Monoid
2033
@@ -77,6 +90,13 @@ instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) whe
7790 declare d = DeclareT (\_ -> return (d, ()))
7891 look = DeclareT (\d -> return (mempty, d))
7992
93+-- | Lift a computation from the simple Declare monad.
94+liftDeclare :: MonadDeclare d m => Declare d a -> m a
95+liftDeclare da = do
96+ (d', a) <- looks (runDeclare da)
97+ declare d'
98+ pure a
99+
80100-- | Retrieve a function of all the output so far.
81101looks :: MonadDeclare d m => (d -> a) -> m a
82102looks f = f <$> look
@@ -125,3 +145,56 @@ execDeclare m = runIdentity . execDeclareT m
125145undeclare :: Monoid d => Declare d a -> a
126146undeclare = runIdentity . undeclareT
127147
148+-- ---------------------------------------------------------------------------
149+-- Instances for other mtl transformers
150+--
151+-- All of these instances need UndecidableInstances,
152+-- because they do not satisfy the coverage condition.
153+
154+instance MonadDeclare d m => MonadDeclare d (ContT r m) where
155+ declare = lift . declare
156+ look = lift look
157+
158+instance MonadDeclare d m => MonadDeclare d (ExceptT e m) where
159+ declare = lift . declare
160+ look = lift look
161+
162+instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
163+ declare = lift . declare
164+ look = lift look
165+
166+instance MonadDeclare d m => MonadDeclare d (ListT m) where
167+ declare = lift . declare
168+ look = lift look
169+
170+instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
171+ declare = lift . declare
172+ look = lift look
173+
174+instance MonadDeclare d m => MonadDeclare d (ReaderT r m) where
175+ declare = lift . declare
176+ look = lift look
177+
178+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.RWST r w s m) where
179+ declare = lift . declare
180+ look = lift look
181+
182+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.RWST r w s m) where
183+ declare = lift . declare
184+ look = lift look
185+
186+instance MonadDeclare d m => MonadDeclare d (Lazy.StateT s m) where
187+ declare = lift . declare
188+ look = lift look
189+
190+instance MonadDeclare d m => MonadDeclare d (Strict.StateT s m) where
191+ declare = lift . declare
192+ look = lift look
193+
194+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.WriterT w m) where
195+ declare = lift . declare
196+ look = lift look
197+
198+instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.WriterT w m) where
199+ declare = lift . declare
200+ look = lift look
swagger2.cabal+1
@@ -56,6 +56,7 @@ library
5656 , template-haskell
5757 , time
5858 , transformers
59+ , transformers-compat >= 0.3
5960 , unordered-containers
6061 , vector
6162 , uuid-types >=1.0.2 && <1.1