request-monad (empty) → 0.1.0.0
raw patch · 8 files changed
+507/−0 lines, 8 filesdep +basedep +mtldep +transformerssetup-changed
Dependencies added: base, mtl, transformers
Files
- CHANGELOG.md +6/−0
- LICENSE +20/−0
- README.md +98/−0
- Setup.hs +2/−0
- request-monad.cabal +31/−0
- src/Control/Monad/Request.hs +23/−0
- src/Control/Monad/Request/Class.hs +97/−0
- src/Control/Monad/Request/Lazy.hs +230/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# 0.1.0.0++* First public release+* Add the `MonadRequest` type class+* Add the `RequestT` monad+* Initial documentation
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Tom Hulihan++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,98 @@+# request-monad++[Hackage](http://hackage.haskell.org/package/request-monad)++This library exports a monad that can be used to abstract a request sending/response handling pattern.+It can be used to implement type-transforming middleware, as well as a way to easily implement stubbing.++## Installation++From the command line:++```shell+$ cabal install request-monad+```++To use data types and functions export from this library:++```haskell+import Control.Monad.Request+```++## Usage++Using `RequestT r r' m a` abstracts sending requests of type `r`, and handling responses of `r'`.+Below is an example of using `RequestT` to ask for somebody's name and age.+Note that there is no logic about _how_ to get and return the strings in `getNameAndAge`, that's all handled in `prompt`.++```haskell+import Control.Monad+import Control.Monad.Request++getNameAndAge :: Monad m => RequestT String String m (String, Int)+getNameAndAge = do+ name <- send "Name: "+ age <- liftM read $ send "Age: "+ return (name, age)++prompt :: String -> IO String+prompt str = putStr str >> getLine++main :: IO ()+main = do+ (name, age) <- runRequestT getNameAndAge prompt+ putStrLn $ name ++ " is " ++ show age ++ " years old."+```++Below is an example of an echo server, which just returns the exact input that it was given.++```haskell+import Control.Monad.Request++pingPong :: Monad m => RequestT String String m (String, String)+pingPong = do+ a <- send "ping"+ b <- send "pong"+ return (a, b)++main :: IO ()+main = do+ let (a, b) = runRequest pingPong id+ putStrLn $ "a: " ++ a -- Prints "a: ping"+ putStrLn $ "b: " ++ b -- Prints "b: pong"+```++Aside from implementation-independant requests, this abstraction also simplifies adding request/response middleware.+The code below adds JSON deserialization to each response.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad+import Control.Monad.Request+import qualified Data.Aeson as A+import qualified Data.ByteString as B++deserialize :: (A.FromJSON a, Monad m) => B.ByteString -> m (Maybe a)+deserialize = return . A.decode++tryTwice :: Monad m => RequestT B.ByteString (Maybe A.Value) m (Maybe A.Value)+tryTwice = mapResponseT deserialize $ do+ a <- send "request one"+ b <- send "request two"+ return $ a `mplus` b++handleRequest :: Monad m => B.ByteString -> m B.ByteString+handleRequest "request one" = return "not json"+handleRequest x = "15"++main :: IO ()+main = do+ let res = runRequest tryTwice handleRequest+ print $ res -- Prints "Just (Number 15)"+```++## TODO++* Make `RequestT` an instance of `MonadCont` and `MonadFix`+* Add a strict version of `RequestT`
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ request-monad.cabal view
@@ -0,0 +1,31 @@+name: request-monad+version: 0.1.0.0+synopsis: A transformer for generic requests+description:+ An MTL-style monad that can be used to perform requests. Using RequestT+ simplifies writing generic middleware.+homepage: http://github.com/nahiluhmot/request-monad+bug-reports: http://github.com/nahiluhmot/request-monad/issues+license: MIT+license-file: LICENSE+author: Tom Hulihan+maintainer: Tom Hulihan <hulihan.tom159@gmail.com>+category: Control+build-type: Simple+extra-source-files: README.md, CHANGELOG.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/nahiluhmot/request-monad.git++library+ hs-source-dirs: src+ build-depends: base >=4.7 && <4.8,+ transformers ==0.4.*,+ mtl ==2.2.*+ exposed-modules: Control.Monad.Request,+ Control.Monad.Request.Class,+ Control.Monad.Request.Lazy+ ghc-options: -O3 -Wall+ default-language: Haskell2010
+ src/Control/Monad/Request.hs view
@@ -0,0 +1,23 @@+{- |+Module : Control.Monad.Request.Class+Copyright : (c) Tom Hulihan <hulihan.tom159@gmail.com> 2014,+License : MIT++Maintainer : hulihan.tom159@gmail.com+Stability : experimental+Portability : non-portable (multi-parameter type classes)++[Computation type:] Compuations that send requests and handle responses++[Binding strategy:] Response callbacks are composed with the binding function++[Useful for:] Implementation-agnostic requests (i.e. making real requests versus+mocking), adding middlewares.++[Example type:] @'Control.Monad.Request.Lazy.Request' String String a@++The Request monad+-}+module Control.Monad.Request ( module Control.Monad.Request.Lazy ) where++import Control.Monad.Request.Lazy
+ src/Control/Monad/Request/Class.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{- |+Module : Control.Monad.Request.Class+Copyright : (c) Tom Hulihan <hulihan.tom159@gmail.com> 2014,+License : MIT++Maintainer : hulihan.tom159@gmail.com+Stability : experimental+Portability : non-portable (multi-parameter type classes)++[Computation type:] Compuations that send requests and handle responses++[Binding strategy:] Response callbacks are composed with the binding function++[Useful for:] Implementation-agnostic requests (i.e. making real requests versus+mocking), adding middlewares.++[Example type:] @'Control.Monad.Request.Lazy.Request' String String a@++The Request monad+-}+module Control.Monad.Request.Class ( MonadRequest(..) ) where++import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Cont as Cont+import Control.Monad.Trans.Identity as Identity+import Control.Monad.Trans.Error as Error+import Control.Monad.Trans.Except as Except+import Control.Monad.Trans.List as List+import Control.Monad.Trans.Maybe as Maybe+import Control.Monad.Trans.RWS.Lazy as RWSL+import Control.Monad.Trans.RWS.Strict as RWSS+import Control.Monad.Trans.Reader as Reader+import Control.Monad.Trans.State.Lazy as StateL+import Control.Monad.Trans.State.Strict as StateS+import Control.Monad.Trans.Writer.Lazy as WriterL+import Control.Monad.Trans.Writer.Strict as WriterS+import Data.Monoid++-- | This type class generalizes monadic requests.+--+-- Parameters:+--+-- * @r@ - The type of request+--+-- * @r'@ - The type of response+--+-- * @m@ - The monad through which the requests are sent+--+class Monad m => MonadRequest r r' m | m -> r r' where+ -- | Given a request of type @r@, perform an action in @m@ whose result is+ -- @r'@.+ send :: r -> m r'++instance MonadRequest r r' m => MonadRequest r r' (IdentityT m) where+ send = IdentityT . send++instance (MonadRequest r r' m) => MonadRequest r r' (ContT x m) where+ send = lift . send++instance (Error e, MonadRequest r r' m) => MonadRequest r r' (ErrorT e m) where+ send = ErrorT . liftM Right . send++instance MonadRequest r r' m => MonadRequest r r' (ExceptT e m) where+ send = ExceptT . liftM Right . send++instance MonadRequest r r' m => MonadRequest r r' (ListT m) where+ send = ListT . liftM (\x -> [x]) . send++instance MonadRequest r r' m => MonadRequest r r' (MaybeT m) where+ send = MaybeT . liftM Just . send++instance (Monoid w, MonadRequest r r' m) => MonadRequest r r' (RWSL.RWST x w s m) where+ send = lift . send++instance (Monoid w, MonadRequest r r' m) => MonadRequest r r' (RWSS.RWST x w s m) where+ send = lift . send++instance MonadRequest r r' m => MonadRequest r r' (ReaderT x m) where+ send = ReaderT . const . send++instance MonadRequest r r' m => MonadRequest r r' (StateL.StateT x m) where+ send r = StateL.StateT $ \s -> send r >>= \a -> return (a, s)++instance MonadRequest r r' m => MonadRequest r r' (StateS.StateT x m) where+ send r = StateS.StateT $ \s -> send r >>= \a -> return (a, s)++instance (Monoid w, MonadRequest r r' m) => MonadRequest r r' (WriterL.WriterT w m) where+ send = WriterL.WriterT . liftM (flip (,) mempty) . send++instance (Monoid w, MonadRequest r r' m) => MonadRequest r r' (WriterS.WriterT w m) where+ send = WriterS.WriterT . liftM (flip (,) mempty) . send
+ src/Control/Monad/Request/Lazy.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+++{- |+Module : Control.Monad.Request.Lazy+Copyright : (c) Tom Hulihan <hulihan.tom159@gmail.com> 2014,+License : MIT++Maintainer : hulihan.tom159@gmail.com+Stability : experimental+Portability : non-portable (multi-parameter type classes)++[Computation type:] Compuations that send requests and handle responses++[Binding strategy:] Response callbacks are composed with the binding function++[Useful for:] Implementation-agnostic requests (i.e. making real requests versus+mocking), adding middlewares.++[Example type:] @'Request' String String a@++The Request monad+-}+module Control.Monad.Request.Lazy ( -- * MonadRequest+ MonadRequest(..)+ -- * Request+ , Request+ , request+ , runRequest+ , mapRequest+ , mapResponse+ -- * RequestT+ , RequestT+ , requestT+ , runRequestT+ , mapRequestT+ , mapResponseT+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Request.Class+import Control.Monad.Trans.Class+import Control.Monad.Error.Class+import Control.Monad.RWS.Class+import Data.Monoid+import Data.Functor.Identity++--------------------------------------------------------------------------------+-- 'Request' and its associated functions++-- | A Request monad, parameterized by the request type, @r@, and response type,+-- @r'@.+-- together.+type Request r r' = RequestT r r' Identity++-- | Turn a request and response callback into a monadic computation.+request :: r -- ^ The request+ -> (r' -> a) -- ^ The response callback+ -> Request r r' a -- ^ The resulting computation+request r g = requestT r (Identity . g)++-- | Evaluate a @'Request' r r\' a@ action.+runRequest :: Request r r' a -- ^ The computation to run+ -> (r -> r') -- ^ A function that turns requests into responses+ -> a -- ^ The final result of the computation+runRequest act f = runIdentity $ runRequestT act (Identity . f)++-- | Given a @x -> r@, transform a computation that sends requests of type @x@+-- into one that sends requests of type @r@.+mapRequest :: (x -> r) -- ^ The middleware function+ -> Request x r' a -- ^ The computation which sends @x@+ -> Request r r' a -- ^ The computation which sends @r@+mapRequest f = mapRequestT (Identity . f)++-- | Given a mapping from @r\' -> x@, transform a computation handles responses+-- of type @x@ to one that handles responses of type @r'@.+mapResponse :: (r' -> x) -- ^ The middleware function+ -> Request r x a -- ^ The computation which handles @x@+ -> Request r r' a -- ^ The computation which handles @r'@+mapResponse f = mapResponseT (Identity . f)++--------------------------------------------------------------------------------+-- 'RequestT' and its associated functions++-- | A request monad, parameterized by the request type, @r@, response type,+-- @r'@, and inner monad, @m@.+data RequestT r r' m a+ = Pure a+ | Request r (r' -> RequestT r r' m a)+ | Lift (m (RequestT r r' m a))++-- | This function takes a request and monadic response handler to produce a+-- @'RequestT' r r\' m a@.+requestT :: Monad m => r -- ^ The request+ -> (r' -> m a) -- ^ The response callback+ -> RequestT r r' m a -- ^ The resulting computation+requestT r g = Request r (Lift . liftM Pure . g)++-- | Given a @'RequestT' r r\' m a@ and a mapping from requests to responses,+-- return a monadic computation which produces @a@.+runRequestT :: Monad m => RequestT r r' m a -- ^ The computation to run+ -> (r -> m r') -- ^ The request function+ -> m a -- ^ The resulting computation+runRequestT m req =+ let go (Pure a) = return a+ go (Request r g) = req r >>= go . g+ go (Lift act) = act >>= go+ in go m++-- | Turn a computation that requests @x@ into a computation that requests @r@.+mapRequestT :: Monad m => (x -> m r) -- ^ The middleware function+ -> RequestT x r' m a -- ^ The @x@-requesting computation+ -> RequestT r r' m a -- ^ The @r@-requesting computation+mapRequestT f =+ let go (Pure a) = Pure a+ go (Request x g) = lift (f x) >>= flip Request (go . g)+ go (Lift act) = Lift (liftM go act)+ in go++-- | Turn a computation that handles @x@ into a computation that handles @r'@.+mapResponseT :: Monad m => (r' -> m x) -- ^ The middleware function+ -> RequestT r x m a -- ^ The @x@-handling computation+ -> RequestT r r' m a -- ^ The @r'@-handling computation+mapResponseT f =+ let go (Pure a) = Pure a+ go (Request r g) = Request r (go . g <=< lift . f)+ go (Lift act) = Lift (liftM go act)+ in go++--------------------------------------------------------------------------------+-- Type class instances from base.++instance Alternative m => Alternative (RequestT r r' m) where+ empty = Lift empty+ (<|>) =+ let go (Pure a) _ = Pure a+ go (Request r g) x = Request r (flip go x . g)+ go (Lift act) x = Lift (fmap (flip go x) act)+ in go++instance Applicative m => Applicative (RequestT r r' m) where+ pure = Pure+ (<*>) =+ let go (Pure f) (Pure a) = Pure (f a)+ go (Request r g) x = Request r (flip go x . g)+ go (Lift act) x = Lift (fmap (flip go x) act)+ go x (Request r g) = Request r (go x . g)+ go x (Lift act) = Lift (fmap (go x) act)+ in go++instance Functor m => Functor (RequestT r r' m) where+ fmap f =+ let go (Pure a) = Pure (f a)+ go (Request r g) = Request r (go . g)+ go (Lift act) = Lift (fmap go act)+ in go++instance Monad m => Monad (RequestT r r' m) where+ return = Pure+ fail = Lift . fail+ (>>=) m f =+ let go (Pure a) = f a+ go (Request r g) = Request r (go . g)+ go (Lift act) = Lift (liftM go act)+ in go m++instance MonadPlus m => MonadPlus (RequestT r r' m) where+ mzero = Lift mzero+ mplus =+ let go (Pure a) _ = Pure a+ go (Request r g) x = Request r (flip go x . g)+ go (Lift act) x = Lift (liftM (flip go x) act)+ in go++--------------------------------------------------------------------------------+-- Type class instances from this library.++instance Monad m => MonadRequest r r' (RequestT r r' m) where+ send = flip Request Pure++--------------------------------------------------------------------------------+-- Type class instances from transformers.++instance MonadIO m => MonadIO (RequestT r r' m) where+ liftIO = lift . liftIO++instance MonadTrans (RequestT r r') where+ lift = Lift . liftM Pure++--------------------------------------------------------------------------------+-- Type class instances from mtl.++instance MonadError e m => MonadError e (RequestT r r' m) where+ throwError = Lift . throwError+ catchError m h =+ let go (Pure a) = Pure a+ go (Request r g) = Request r (go . g)+ go (Lift act) = Lift (catchError act (return . h))+ in go m+++instance MonadReader x m => MonadReader x (RequestT r r' m) where+ ask = lift ask+ local f =+ let go (Pure a) = Pure a+ go (Request r g) = Request r (go . g)+ go (Lift act) = Lift (liftM go (local f act))+ in go++instance (Monoid w, MonadReader r m, MonadWriter w m, MonadState s m) => MonadRWS r w s (RequestT r r' m)++instance MonadState s m => MonadState s (RequestT r r' m) where+ get = lift get+ put = lift . put++instance (Monoid w, MonadWriter w m) => MonadWriter w (RequestT r r' m) where+ writer = lift . writer+ tell = lift . tell+ listen =+ let go acc (Pure a) = Pure (a, acc)+ go acc (Request r g) = Request r (go acc . g)+ go acc (Lift act) = Lift $ do+ ~(m, w) <- listen act+ return (go (acc `mappend` w) m)+ in go mempty+ pass m = listen m >>= \ ~(~(a, f), w) -> writer (a, f w)