git.iko.soy/typeable/openapi3
on fbc117e help sign in
typeable/openapi3/src/Data/Swagger/Declare.hs
199 lines 6.6 kB history raw
1{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE UndecidableInstances #-}
6-- |
7-- Module: Data.Swagger.Declare
8-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
9-- Stability: experimental
10--
11-- Declare monad transformer and associated functions.
12module Data.Swagger.Declare where
14import Prelude ()
15import Prelude.Compat
17import Control.Monad
18import Control.Monad.Cont (ContT)
19import Control.Monad.List (ListT)
20import Control.Monad.Reader (ReaderT)
21import Control.Monad.Trans
22import Control.Monad.Trans.Except (ExceptT)
23import Control.Monad.Trans.Identity (IdentityT)
24import Control.Monad.Trans.Maybe (MaybeT)
25import Control.Monad.Trans.State.Lazy as Lazy
26import Control.Monad.Trans.State.Strict as Strict
27import Control.Monad.Trans.RWS.Lazy as Lazy
28import Control.Monad.Trans.RWS.Strict as Strict
29import Control.Monad.Trans.Writer.Lazy as Lazy
30import Control.Monad.Trans.Writer.Strict as Strict
31import Data.Functor.Identity
33-- | A declare monad transformer parametrized by:
34--
35-- * @d@ — the output to accumulate (declarations);
36--
37-- * @m@ — the inner monad.
38--
39-- This monad transformer is similar to both state and writer monad transformers.
40-- Thus it can be seen as
41--
42-- * a restricted append-only version of a state monad transformer or
43--
44-- * a writer monad transformer with the extra ability to read all previous output.
45newtype DeclareT d m a = DeclareT { runDeclareT :: d -> m (d, a) }
46 deriving (Functor)
48instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where
49 pure x = DeclareT (\_ -> pure (mempty, x))
50 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do
51 ~(d', f) <- df d
52 ~(d'', x) <- dx (mappend d d')
53 return (mappend d' d'', f x)
55instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where
56 return x = DeclareT (\_ -> pure (mempty, x))
57 DeclareT dx >>= f = DeclareT $ \d -> do
58 ~(d', x) <- dx d
59 ~(d'', y) <- runDeclareT (f x) (mappend d d')
60 return (mappend d' d'', y)
62instance Monoid d => MonadTrans (DeclareT d) where
63 lift m = DeclareT (\_ -> (,) mempty `liftM` m)
65-- |
66-- Definitions of @declare@ and @look@ must satisfy the following laws:
67--
68-- [/monoid homomorphism (mempty)/]
69-- @'declare' mempty == return ()@
70--
71-- [/monoid homomorphism (mappend)/]
72-- @'declare' x >> 'declare' y == 'declare' (x <> y)@
73-- for every @x@, @y@
74--
75-- [/@declare@-@look@/]
76-- @'declare' x >> 'look' == 'fmap' (<> x) 'look' <* 'declare' x@
77-- for every @x@
78--
79-- [/@look@ as left identity/]
80-- @'look' >> m == m@
81-- for every @m@
82class (Applicative m, Monad m) => MonadDeclare d m | m -> d where
83 -- | @'declare' x@ is an action that produces the output @x@.
84 declare :: d -> m ()
85 -- | @'look'@ is an action that returns all the output so far.
86 look :: m d
88instance (Applicative m, Monad m, Monoid d) => MonadDeclare d (DeclareT d m) where
89 declare d = DeclareT (\_ -> return (d, ()))
90 look = DeclareT (\d -> return (mempty, d))
92-- | Lift a computation from the simple Declare monad.
93liftDeclare :: MonadDeclare d m => Declare d a -> m a
94liftDeclare da = do
95 (d', a) <- looks (runDeclare da)
96 declare d'
97 pure a
99-- | Retrieve a function of all the output so far.
100looks :: MonadDeclare d m => (d -> a) -> m a
101looks f = f <$> look
103-- | Evaluate @'DeclareT' d m a@ computation,
104-- ignoring new output @d@.
105evalDeclareT :: Monad m => DeclareT d m a -> d -> m a
106evalDeclareT (DeclareT f) d = snd `liftM` f d
108-- | Execute @'DeclateT' d m a@ computation,
109-- ignoring result and only producing new output @d@.
110execDeclareT :: Monad m => DeclareT d m a -> d -> m d
111execDeclareT (DeclareT f) d = fst `liftM` f d
113-- | Evaluate @'DeclareT' d m a@ computation,
114-- starting with empty output history.
115undeclareT :: (Monad m, Monoid d) => DeclareT d m a -> m a
116undeclareT = flip evalDeclareT mempty
118-- | A declare monad parametrized by @d@ — the output to accumulate (declarations).
119--
120-- This monad is similar to both state and writer monads.
121-- Thus it can be seen as
122--
123-- * a restricted append-only version of a state monad or
124--
125-- * a writer monad with the extra ability to read all previous output.
126type Declare d = DeclareT d Identity
128-- | Run @'Declare' d a@ computation with output history @d@,
129-- producing result @a@ and new output @d@.
130runDeclare :: Declare d a -> d -> (d, a)
131runDeclare m = runIdentity . runDeclareT m
133-- | Evaluate @'Declare' d a@ computation, ignoring output @d@.
134evalDeclare :: Declare d a -> d -> a
135evalDeclare m = runIdentity . evalDeclareT m
137-- | Execute @'Declate' d a@ computation, ignoring result and only
138-- producing output @d@.
139execDeclare :: Declare d a -> d -> d
140execDeclare m = runIdentity . execDeclareT m
142-- | Evaluate @'DeclareT' d m a@ computation,
143-- starting with empty output history.
144undeclare :: Monoid d => Declare d a -> a
145undeclare = runIdentity . undeclareT
147-- ---------------------------------------------------------------------------
148-- Instances for other mtl transformers
149--
150-- All of these instances need UndecidableInstances,
151-- because they do not satisfy the coverage condition.
153instance MonadDeclare d m => MonadDeclare d (ContT r m) where
154 declare = lift . declare
155 look = lift look
157instance MonadDeclare d m => MonadDeclare d (ExceptT e m) where
158 declare = lift . declare
159 look = lift look
161instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
162 declare = lift . declare
163 look = lift look
165instance MonadDeclare d m => MonadDeclare d (ListT m) where
166 declare = lift . declare
167 look = lift look
169instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
170 declare = lift . declare
171 look = lift look
173instance MonadDeclare d m => MonadDeclare d (ReaderT r m) where
174 declare = lift . declare
175 look = lift look
177instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.RWST r w s m) where
178 declare = lift . declare
179 look = lift look
181instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.RWST r w s m) where
182 declare = lift . declare
183 look = lift look
185instance MonadDeclare d m => MonadDeclare d (Lazy.StateT s m) where
186 declare = lift . declare
187 look = lift look
189instance MonadDeclare d m => MonadDeclare d (Strict.StateT s m) where
190 declare = lift . declare
191 look = lift look
193instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Lazy.WriterT w m) where
194 declare = lift . declare
195 look = lift look
197instance (Monoid w, MonadDeclare d m) => MonadDeclare d (Strict.WriterT w m) where
198 declare = lift . declare
199 look = lift look