{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.OpenApi.Declare where
import Prelude ()
import Prelude.Compat
import Control.Monad
import Control.Monad.Cont (ContT)
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
newtype DeclareT d m a = DeclareT { forall d (m :: * -> *) a. DeclareT d m a -> d -> m (d, a)
runDeclareT :: d -> m (d, a) }
deriving ((forall a b. (a -> b) -> DeclareT d m a -> DeclareT d m b)
-> (forall a b. a -> DeclareT d m b -> DeclareT d m a)
-> Functor (DeclareT d m)
forall a b. a -> DeclareT d m b -> DeclareT d m a
forall a b. (a -> b) -> DeclareT d m a -> DeclareT d m b
forall d (m :: * -> *) a b.
Functor m =>
a -> DeclareT d m b -> DeclareT d m a
forall d (m :: * -> *) a b.
Functor m =>
(a -> b) -> DeclareT d m a -> DeclareT d m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall d (m :: * -> *) a b.
Functor m =>
(a -> b) -> DeclareT d m a -> DeclareT d m b
fmap :: forall a b. (a -> b) -> DeclareT d m a -> DeclareT d m b
$c<$ :: forall d (m :: * -> *) a b.
Functor m =>
a -> DeclareT d m b -> DeclareT d m a
<$ :: forall a b. a -> DeclareT d m b -> DeclareT d m a
Functor)
instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where
pure :: forall a. a -> DeclareT d m a
pure a
x = (d -> m (d, a)) -> DeclareT d m a
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT (\d
_ -> (d, a) -> m (d, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (d
forall a. Monoid a => a
mempty, a
x))
DeclareT d -> m (d, a -> b)
df <*> :: forall a b.
DeclareT d m (a -> b) -> DeclareT d m a -> DeclareT d m b
<*> DeclareT d -> m (d, a)
dx = (d -> m (d, b)) -> DeclareT d m b
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT ((d -> m (d, b)) -> DeclareT d m b)
-> (d -> m (d, b)) -> DeclareT d m b
forall a b. (a -> b) -> a -> b
$ \d
d -> do
~(d
d', a -> b
f) <- d -> m (d, a -> b)
df d
d
~(d
d'', a
x) <- d -> m (d, a)
dx (d -> d -> d
forall a. Monoid a => a -> a -> a
mappend d
d d
d')
(d, b) -> m (d, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> d -> d
forall a. Monoid a => a -> a -> a
mappend d
d' d
d'', a -> b
f a
x)
instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where
return :: forall a. a -> DeclareT d m a
return a
x = (d -> m (d, a)) -> DeclareT d m a
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT (\d
_ -> (d, a) -> m (d, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (d
forall a. Monoid a => a
mempty, a
x))
DeclareT d -> m (d, a)
dx >>= :: forall a b.
DeclareT d m a -> (a -> DeclareT d m b) -> DeclareT d m b
>>= a -> DeclareT d m b
f = (d -> m (d, b)) -> DeclareT d m b
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT ((d -> m (d, b)) -> DeclareT d m b)
-> (d -> m (d, b)) -> DeclareT d m b
forall a b. (a -> b) -> a -> b
$ \d
d -> do
~(d
d', a
x) <- d -> m (d, a)
dx d
d
~(d
d'', b
y) <- DeclareT d m b -> d -> m (d, b)
forall d (m :: * -> *) a. DeclareT d m a -> d -> m (d, a)
runDeclareT (a -> DeclareT d m b
f a
x) (d -> d -> d
forall a. Monoid a => a -> a -> a
mappend d
d d
d')
(d, b) -> m (d, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> d -> d
forall a. Monoid a => a -> a -> a
mappend d
d' d
d'', b
y)
instance Monoid d => MonadTrans (DeclareT d) where
lift :: forall (m :: * -> *) a. Monad m => m a -> DeclareT d m a
lift m a
m = (d -> m (d, a)) -> DeclareT d m a
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT (\d
_ -> (,) d
forall a. Monoid a => a
mempty (a -> (d, a)) -> m a -> m (d, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m)
class (Applicative m, Monad m) => MonadDeclare d m | m -> d where
declare :: d -> m ()
look :: m d
instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where
declare :: d -> DeclareT d m ()
declare d
d = (d -> m (d, ())) -> DeclareT d m ()
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT (\d
_ -> (d, ()) -> m (d, ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d, ()))
look :: DeclareT d m d
look = (d -> m (d, d)) -> DeclareT d m d
forall d (m :: * -> *) a. (d -> m (d, a)) -> DeclareT d m a
DeclareT (\d
d -> (d, d) -> m (d, d)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (d
forall a. Monoid a => a
mempty, d
d))
liftDeclare :: MonadDeclare d m => Declare d a -> m a
liftDeclare :: forall d (m :: * -> *) a. MonadDeclare d m => Declare d a -> m a
liftDeclare Declare d a
da = do
(d
d', a
a) <- (d -> (d, a)) -> m (d, a)
forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks (Declare d a -> d -> (d, a)
forall d a. Declare d a -> d -> (d, a)
runDeclare Declare d a
da)
d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare d
d'
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
looks :: MonadDeclare d m => (d -> a) -> m a
looks :: forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks d -> a
f = d -> a
f (d -> a) -> m d -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
evalDeclareT :: Monad m => DeclareT d m a -> d -> m a
evalDeclareT :: forall (m :: * -> *) d a. Monad m => DeclareT d m a -> d -> m a
evalDeclareT (DeclareT d -> m (d, a)
f) d
d = (d, a) -> a
forall a b. (a, b) -> b
snd ((d, a) -> a) -> m (d, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> m (d, a)
f d
d
execDeclareT :: Monad m => DeclareT d m a -> d -> m d
execDeclareT :: forall (m :: * -> *) d a. Monad m => DeclareT d m a -> d -> m d
execDeclareT (DeclareT d -> m (d, a)
f) d
d = (d, a) -> d
forall a b. (a, b) -> a
fst ((d, a) -> d) -> m (d, a) -> m d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> m (d, a)
f d
d
undeclareT :: (Monad m, Monoid d) => DeclareT d m a -> m a
undeclareT :: forall (m :: * -> *) d a.
(Monad m, Monoid d) =>
DeclareT d m a -> m a
undeclareT = (DeclareT d m a -> d -> m a) -> d -> DeclareT d m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DeclareT d m a -> d -> m a
forall (m :: * -> *) d a. Monad m => DeclareT d m a -> d -> m a
evalDeclareT d
forall a. Monoid a => a
mempty
type Declare d = DeclareT d Identity
runDeclare :: Declare d a -> d -> (d, a)
runDeclare :: forall d a. Declare d a -> d -> (d, a)
runDeclare Declare d a
m = Identity (d, a) -> (d, a)
forall a. Identity a -> a
runIdentity (Identity (d, a) -> (d, a))
-> (d -> Identity (d, a)) -> d -> (d, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declare d a -> d -> Identity (d, a)
forall d (m :: * -> *) a. DeclareT d m a -> d -> m (d, a)
runDeclareT Declare d a
m
evalDeclare :: Declare d a -> d -> a
evalDeclare :: forall d a. Declare d a -> d -> a
evalDeclare Declare d a
m = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (d -> Identity a) -> d -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declare d a -> d -> Identity a
forall (m :: * -> *) d a. Monad m => DeclareT d m a -> d -> m a
evalDeclareT Declare d a
m
execDeclare :: Declare d a -> d -> d
execDeclare :: forall d a. Declare d a -> d -> d
execDeclare Declare d a
m = Identity d -> d
forall a. Identity a -> a
runIdentity (Identity d -> d) -> (d -> Identity d) -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declare d a -> d -> Identity d
forall (m :: * -> *) d a. Monad m => DeclareT d m a -> d -> m d
execDeclareT Declare d a
m
undeclare :: Monoid d => Declare d a -> a
undeclare :: forall d a. Monoid d => Declare d a -> a
undeclare = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (Declare d a -> Identity a) -> Declare d a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declare d a -> Identity a
forall (m :: * -> *) d a.
(Monad m, Monoid d) =>
DeclareT d m a -> m a
undeclareT
instance MonadDeclare d m => MonadDeclare d (ContT r m) where
declare :: d -> ContT r m ()
declare = m () -> ContT r m ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ContT r m ()) -> (d -> m ()) -> d -> ContT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: ContT r m d
look = m d -> ContT r m d
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (ExceptT e m) where
declare :: d -> ExceptT e m ()
declare = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> (d -> m ()) -> d -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: ExceptT e m d
look = m d -> ExceptT e m d
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
declare :: d -> IdentityT m ()
declare = m () -> IdentityT m ()
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> IdentityT m ()) -> (d -> m ()) -> d -> IdentityT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: IdentityT m d
look = m d -> IdentityT m d
forall (m :: * -> *) a. Monad m => m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
declare :: d -> MaybeT m ()
declare = m () -> MaybeT m ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MaybeT m ()) -> (d -> m ()) -> d -> MaybeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: MaybeT m d
look = m d -> MaybeT m d
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (ReaderT r m) where
declare :: d -> ReaderT r m ()
declare = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> (d -> m ()) -> d -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: ReaderT r m d
look = m d -> ReaderT r m d
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.RWST r w s m) where
declare :: d -> RWST r w s m ()
declare = m () -> RWST r w s m ()
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ()) -> (d -> m ()) -> d -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: RWST r w s m d
look = m d -> RWST r w s m d
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.RWST r w s m) where
declare :: d -> RWST r w s m ()
declare = m () -> RWST r w s m ()
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ()) -> (d -> m ()) -> d -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: RWST r w s m d
look = m d -> RWST r w s m d
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (Lazy.StateT s m) where
declare :: d -> StateT s m ()
declare = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (d -> m ()) -> d -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: StateT s m d
look = m d -> StateT s m d
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance MonadDeclare d m => MonadDeclare d (Strict.StateT s m) where
declare :: d -> StateT s m ()
declare = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (d -> m ()) -> d -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: StateT s m d
look = m d -> StateT s m d
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.WriterT w m) where
declare :: d -> WriterT w m ()
declare = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (d -> m ()) -> d -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: WriterT w m d
look = m d -> WriterT w m d
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look
instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.WriterT w m) where
declare :: d -> WriterT w m ()
declare = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (d -> m ()) -> d -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> m ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare
look :: WriterT w m d
look = m d -> WriterT w m d
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m d
forall d (m :: * -> *). MonadDeclare d m => m d
look