Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make MonadDeclare more useful #100

Merged
merged 9 commits into from
Apr 25, 2017
53 changes: 53 additions & 0 deletions src/Data/Swagger/Declare.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module: Data.Swagger.Declare
-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
Expand All @@ -14,7 +15,15 @@ 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.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Data.Functor.Identity
import Data.Monoid

Expand Down Expand Up @@ -77,6 +86,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
Expand Down Expand Up @@ -125,3 +141,40 @@ 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.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
1 change: 1 addition & 0 deletions swagger2.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ library
, template-haskell
, time
, transformers
, transformers-compat >= 0.3
, unordered-containers
, vector
, uuid-types >=1.0.2 && <1.1
Expand Down