packages feed

http-monad 0.0.1 → 0.1

raw patch · 8 files changed

+96/−70 lines, 8 filesdep ~explicit-exceptiondep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: explicit-exception, transformers

API changes (from Hackage documentation)

- Network.Monad.Body: instance (CharType char) => C [char]
- Network.Monad.HTTP: instance (Monoid body) => Monoid (ChunkedResponse body)
- Network.Monad.HTTP: instance (Show body) => Show (ChunkedResponse body)
- Network.Monad.Transfer.ChunkyLazyIO: instance (CharType char) => Body [char]
- Network.Monad.Transfer.Offline: instance (CharType char) => Body [char]
+ Network.Monad.Body: instance CharType char => C [char]
+ Network.Monad.HTTP: instance Monoid body => Monoid (ChunkedResponse body)
+ Network.Monad.HTTP: instance Show body => Show (ChunkedResponse body)
+ Network.Monad.Transfer.ChunkyLazyIO: instance CharType char => Body [char]
+ Network.Monad.Transfer.Offline: instance CharType char => Body [char]
- Network.Monad.Body: class (Monoid body) => C body
+ Network.Monad.Body: class Monoid body => C body
- Network.Monad.Body: fromChar :: (CharType char) => Char -> char
+ Network.Monad.Body: fromChar :: CharType char => Char -> char
- Network.Monad.Body: fromString :: (C body) => String -> body
+ Network.Monad.Body: fromString :: C body => String -> body
- Network.Monad.Body: isEmpty :: (C body) => body -> Bool
+ Network.Monad.Body: isEmpty :: C body => body -> Bool
- Network.Monad.Body: isLineTerm :: (C body) => body -> Bool
+ Network.Monad.Body: isLineTerm :: C body => body -> Bool
- Network.Monad.Body: toChar :: (CharType char) => char -> Char
+ Network.Monad.Body: toChar :: CharType char => char -> Char
- Network.Monad.Body: toString :: (C body) => body -> String
+ Network.Monad.Body: toString :: C body => body -> String
- Network.Monad.HTTP.Header: find :: (HasHeaders a) => Name -> a -> Maybe String
+ Network.Monad.HTTP.Header: find :: HasHeaders a => Name -> a -> Maybe String
- Network.Monad.HTTP.Header: findMany :: (HasHeaders a) => Name -> a -> [String]
+ Network.Monad.HTTP.Header: findMany :: HasHeaders a => Name -> a -> [String]
- Network.Monad.HTTP.Header: getHeaders :: (HasHeaders x) => x -> [Header]
+ Network.Monad.HTTP.Header: getHeaders :: HasHeaders x => x -> [Header]
- Network.Monad.HTTP.Header: getMany :: (HasHeaders x) => x -> [T]
+ Network.Monad.HTTP.Header: getMany :: HasHeaders x => x -> [T]
- Network.Monad.HTTP.Header: insert :: (HasHeaders a) => Name -> String -> a -> a
+ Network.Monad.HTTP.Header: insert :: HasHeaders a => Name -> String -> a -> a
- Network.Monad.HTTP.Header: insertIfMissing :: (HasHeaders a) => Name -> String -> a -> a
+ Network.Monad.HTTP.Header: insertIfMissing :: HasHeaders a => Name -> String -> a -> a
- Network.Monad.HTTP.Header: insertMany :: (HasHeaders a) => [T] -> a -> a
+ Network.Monad.HTTP.Header: insertMany :: HasHeaders a => [T] -> a -> a
- Network.Monad.HTTP.Header: modifyMany :: (HasHeaders x) => ([T] -> [T]) -> x -> x
+ Network.Monad.HTTP.Header: modifyMany :: HasHeaders x => ([T] -> [T]) -> x -> x
- Network.Monad.HTTP.Header: replace :: (HasHeaders a) => Name -> String -> a -> a
+ Network.Monad.HTTP.Header: replace :: HasHeaders a => Name -> String -> a -> a
- Network.Monad.HTTP.Header: retrieveMany :: (HasHeaders a) => Name -> a -> [T]
+ Network.Monad.HTTP.Header: retrieveMany :: HasHeaders a => Name -> a -> [T]
- Network.Monad.HTTP.Header: setHeaders :: (HasHeaders x) => x -> [Header] -> x
+ Network.Monad.HTTP.Header: setHeaders :: HasHeaders x => x -> [Header] -> x
- Network.Monad.HTTP.Header: setMany :: (HasHeaders x) => x -> [T] -> x
+ Network.Monad.HTTP.Header: setMany :: HasHeaders x => x -> [T] -> x
- Network.Monad.Reader: readBlock :: (Monad m) => Int -> AsyncExceptional body m body
+ Network.Monad.Reader: readBlock :: Monad m => Int -> AsyncExceptional body m body
- Network.Monad.Reader: readLine :: (Monad m) => AsyncExceptional body m body
+ Network.Monad.Reader: readLine :: Monad m => AsyncExceptional body m body
- Network.Monad.Reader: type AsyncExceptional body m a = (T body m) (Exceptional ConnError a)
+ Network.Monad.Reader: type AsyncExceptional body m = ExceptionalT ConnError (T body m)
- Network.Monad.Reader: type SyncExceptional body m a = ExceptionalT ConnError (T body m) a
+ Network.Monad.Reader: type SyncExceptional body m = ExceptionalT ConnError (T body m)
- Network.Monad.Reader: writeBlock :: (Monad m) => body -> SyncExceptional body m ()
+ Network.Monad.Reader: writeBlock :: Monad m => body -> SyncExceptional body m ()
- Network.Monad.Transfer: liftIOSync :: (MonadIO io) => IO (Result a) -> SyncExceptional io a
+ Network.Monad.Transfer: liftIOSync :: MonadIO io => IO (Result a) -> SyncExceptional io a
- Network.Monad.Transfer: type AsyncExceptional m a = m (Exceptional ConnError a)
+ Network.Monad.Transfer: type AsyncExceptional m = ExceptionalT ConnError m
- Network.Monad.Transfer.ChunkyLazyIO: class (C body) => Body body
+ Network.Monad.Transfer.ChunkyLazyIO: class C body => Body body
- Network.Monad.Transfer.ChunkyLazyIO: length :: (Body body) => body -> Int
+ Network.Monad.Transfer.ChunkyLazyIO: length :: Body body => body -> Int
- Network.Monad.Transfer.Offline: breakAfter :: (Body body) => (Char -> Bool) -> body -> (body, body)
+ Network.Monad.Transfer.Offline: breakAfter :: Body body => (Char -> Bool) -> body -> (body, body)
- Network.Monad.Transfer.Offline: class (C body) => Body body
+ Network.Monad.Transfer.Offline: class C body => Body body
- Network.Monad.Transfer.Offline: run :: (Body body) => T body (T body) a -> ConnError -> body -> (a, body, [body])
+ Network.Monad.Transfer.Offline: run :: Body body => T body (T body) a -> ConnError -> body -> (a, body, [body])
- Network.Monad.Transfer.Offline: splitAt :: (Body body) => Int -> body -> (body, body)
+ Network.Monad.Transfer.Offline: splitAt :: Body body => Int -> body -> (body, body)
- Network.Monad.Transfer.Offline: transfer :: (Body body) => T (T body) body
+ Network.Monad.Transfer.Offline: transfer :: Body body => T (T body) body
- Network.Monad.Transfer.Offline: withBuffer :: (C body) => (body -> (a, body)) -> AsyncExceptional (T body) a
+ Network.Monad.Transfer.Offline: withBuffer :: C body => (body -> (a, body)) -> AsyncExceptional (T body) a

Files

http-monad.cabal view
@@ -1,5 +1,5 @@ Name:               http-monad-Version:            0.0.1+Version:            0.1 Cabal-Version:      >= 1.6 Build-type:         Simple License:            BSD3@@ -9,7 +9,7 @@ Author:             Henning Thielemann <http@henning-thielemann.de> Maintainer:         Henning Thielemann <http@henning-thielemann.de> -- Homepage:           http://www.haskell.org/http/-Synopsis:           Monad abstraction for HTTP communication allowing lazy transfer and non-I/O simulation+Synopsis:           Monad abstraction for HTTP allowing lazy transfer and non-I/O simulation Description:   This library implements a monad class with various interesting instances:   .@@ -30,7 +30,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/http-monad/-  tag:      0.0.1+  tag:      0.0.2  Flag splitBase   description: Old, monolithic base@@ -59,8 +59,8 @@   Build-depends: HTTP >=4000 && <4001   Build-depends: network >=2.1 && <3, parsec >=2.1 && <3   Build-depends: bytestring >=0.9 && <0.10-  Build-depends: transformers >=0.0.1 && <0.2-  Build-depends: explicit-exception >=0.1 && <0.2+  Build-depends: transformers >=0.2 && <0.3+  Build-depends: explicit-exception >=0.1.4 && <0.2   Build-depends: utility-ht >=0.0.4 && <0.1   Build-depends: lazyio >=0.0.2 && <0.1
src/Network/Monad/Exception.hs view
@@ -14,12 +14,25 @@  import qualified Control.Monad.Exception.Asynchronous as Async import qualified Control.Monad.Exception.Synchronous  as Sync+import Control.Applicative (WrappedMonad(WrapMonad), unwrapMonad, )  import Control.Monad (liftM, ) import Data.Monoid (Monoid, mappend, ) +import Prelude hiding (map, ) + type AsyncExceptionalT e m a = m (Async.Exceptional e a)++-- in contrast to 'fmap' it does require Monad instance, not Functor+map ::+   (Monad m) =>+   (a -> b) ->+   Async.ExceptionalT body m a -> Async.ExceptionalT body m b+map f =+   Async.mapExceptionalT unwrapMonad .+   fmap f .+   Async.mapExceptionalT WrapMonad  infixr 1 `bind`, `append`, `continue`
src/Network/Monad/HTTP.hs view
@@ -27,7 +27,7 @@     Response(..), ResponseData, ResponseCode, )  import Network.Monad.Reader (readLine, readBlock, writeBlock, )-import Control.Monad.Trans (lift, )+import Control.Monad.Trans.Class (lift, )  import qualified Control.Monad.Exception.Asynchronous as Async import qualified Control.Monad.Exception.Synchronous  as Sync@@ -47,7 +47,7 @@    Sync.ExceptionalT ConnError (StreamMonad.T body m) a  type AsynchronousExceptional body m a =-   (StreamMonad.T body m) (Async.Exceptional ConnError a)+   Async.ExceptionalT ConnError (StreamMonad.T body m) a   @@ -178,7 +178,8 @@ getResponseHead :: (Monad m, Body.C body) => SynchronousExceptional body m (Async.Exceptional ConnError ResponseData) getResponseHead =    Sync.ExceptionalT $-   liftM (Async.sequence . fmap (parseResponseHead . map Body.toString)) readTillEmpty1+   liftM (Async.sequence . fmap (parseResponseHead . map Body.toString)) $+   Async.runExceptionalT readTillEmpty1  withResponseHead :: (Monad m, Body.C body) => (ResponseData -> SynchronousExceptional body m (Async.Exceptional ConnError (Response body))) -> SynchronousExceptional body m (Async.Exceptional ConnError (Response body)) withResponseHead =@@ -226,7 +227,8 @@       ExpectEntity ->          let tc = Header.lookup Header.HdrTransferEncoding hdrs              cl = Header.lookup Header.HdrContentLength hdrs-         in  lift $ assembleHeaderBody (Response cd rn) hdrs $+         in  lift $ Async.runExceptionalT $+             assembleHeaderBody (Response cd rn) hdrs $              case tc of                 Nothing ->                    case cl of@@ -268,13 +270,14 @@ receive =    Exc.switchM getRequestHead       (\(rm,uri,hdrs) -> return $ Request uri rm hdrs mempty)-      (lift . processRequest)+      (lift . Async.runExceptionalT . processRequest)  -- | Reads and parses request headers. getRequestHead :: (Monad m, Body.C body) => SynchronousExceptional body m (Async.Exceptional ConnError RequestData) getRequestHead =    Sync.ExceptionalT $-   liftM (Async.sequence . fmap (parseRequestHead . map Body.toString)) readTillEmpty1+   liftM (Async.sequence . fmap (parseRequestHead . map Body.toString)) $+   Async.runExceptionalT readTillEmpty1  -- | Process request body (called after successful getRequestHead) processRequest :: (Monad m, Body.C body) => RequestData -> AsynchronousExceptional body m (Request body)@@ -287,7 +290,7 @@           Nothing ->              case cl of                 Just x  -> linearTransferStrLen x-                Nothing -> return $ Async.pure ([], mempty)+                Nothing -> mempty                 -- hopefulTransfer           Just x  ->              case map toLower (trim x) of@@ -301,8 +304,8 @@ -} assembleHeaderBody :: (Monad m) => ([Header.T] -> body -> a) -> [Header.T] -> AsynchronousExceptional body m ([Header.T], body) -> AsynchronousExceptional body m a assembleHeaderBody make hdrs =-   liftM (fmap (\(_ftrs,bdy) -> make hdrs bdy))---   liftM (fmap (\(ftrs,bdy) -> make (hdrs++ftrs) bdy))+   Exc.map (\(_ftrs,bdy) -> make hdrs bdy)+--   Exc.map (\(ftrs,bdy) -> make (hdrs++ftrs) bdy)  {- | Very simple function, send a HTTP response over the given stream.@@ -324,12 +327,12 @@ linearTransferStrLen ns =    case reads ns of       [(n,"")] -> linearTransfer n-      _ -> return $ Async.throwMonoid $ ErrorParse $ "Content-Length header contains not a number: " ++ show ns+      _ -> Async.throwMonoidT $ ErrorParse $ "Content-Length header contains not a number: " ++ show ns  -- | Used when we know exactly how many bytes to expect. linearTransfer :: Monad m => Int -> AsynchronousExceptional body m ([Header.T],body) linearTransfer n =-   liftM (fmap ((,) [])) $ readBlock n+   Exc.map ((,) []) $ readBlock n  -- | Used when nothing about data is known, --   Unfortunately waiting for a socket closure@@ -340,9 +343,9 @@    let go =          readLineSwitch $ \line ->             if Body.isEmpty line-              then return $ Async.pure mempty-              else liftM (fmap (mappend line)) go-   in  liftM (fmap ((,) [])) go+              then mempty+              else Exc.map (mappend line) go+   in  Exc.map ((,) []) go   -- | in contrast to built-in @(,,)@, its mappend implementation is lazy@@ -366,11 +369,11 @@ -} chunkedTransfer :: (Monad m, Body.C body) => Bool -> AsynchronousExceptional body m ([Header.T],body) chunkedTransfer attachLength =-   liftM (fmap (\(ChunkedResponse ftrs sizes info) ->+   Exc.map (\(ChunkedResponse ftrs sizes info) ->       ((if attachLength           then (Header.Header Header.HdrContentLength (show $ sum sizes) :)           else id) ftrs,-       info))) $+       info)) $    chunkedTransferLoop  {- we do not sum up the chunk size here@@ -382,20 +385,20 @@          [(size,_)] ->             if size == 0               then-                 liftM-                    (fmap (\strs -> ChunkedResponse (Header.parseManyStraight $ map Body.toString strs) [0] mempty))+                 Exc.map (\strs -> ChunkedResponse (Header.parseManyStraight $ map Body.toString strs) [0] mempty)                     readTillEmpty2               else-                 liftM (fmap (\block -> ChunkedResponse [] [0] block)) (readBlock size)-                 `Async.appendM`-                 (liftM-                    (\newLineE ->-                        mplus-                          (Async.exception newLineE)-                          (toMaybe-                             (not $ Body.isLineTerm $ Async.result newLineE)-                             (ErrorParse $ "no CR+LF after chunk"))) $-                  readBlock 2)+                 Exc.map (\block -> ChunkedResponse [] [0] block) (readBlock size)+                 `mappend`+                 Async.ExceptionalT+                 ((liftM+                     (\newLineE ->+                         mplus+                           (Async.exception newLineE)+                           (toMaybe+                              (not $ Body.isLineTerm $ Async.result newLineE)+                              (ErrorParse $ "no CR+LF after chunk"))) $+                   Async.runExceptionalT (readBlock 2)) {- less efficient since it reads an entire line                  (liftM (\newLineE ->@@ -408,12 +411,12 @@                                      ))                   readLine) -}-                 `Async.continueM`-                 liftM (fmap forceCR) chunkedTransferLoop+                  `Async.continueM`+                  Async.runExceptionalT (Exc.map forceCR chunkedTransferLoop))          _ ->             {- old implementation continued reading anyway in this case                as if the Chunk length was 0 -}-            return $ Async.throwMonoid+            Async.throwMonoidT                (ErrorParse $ "Chunk-Length is not a number: " ++ show (Body.toString line))  @@ -422,8 +425,7 @@ --   the name. uglyDeathTransfer :: (Monad m, Monoid body) => AsynchronousExceptional body m ([Header.T],body) uglyDeathTransfer =-   return $-   Async.throwMonoid $+   Async.throwMonoidT $    ErrorParse "Unknown Transfer-Encoding"  @@ -436,7 +438,7 @@    readLineSwitch $ \s ->       if Body.isLineTerm s         then readTillEmpty1-        else liftM (fmap (s:)) readTillEmpty2+        else Exc.map (s:) readTillEmpty2  -- | Read lines until an empty line (CRLF), --   also accepts a connection close as end of@@ -447,8 +449,8 @@ readTillEmpty2 =    readLineSwitch $ \s ->       if Body.isLineTerm s || Body.isEmpty s-        then return $ Async.pure []-        else liftM (fmap (s:)) readTillEmpty2+        then mempty+        else Exc.map (s:) readTillEmpty2   {- |@@ -459,7 +461,7 @@ -} readLineSwitch :: (Monad m, Monoid a) => (body -> AsynchronousExceptional body m a) -> AsynchronousExceptional body m a readLineSwitch next =-   Exc.bind (Sync.ExceptionalT $ liftM Async.toSynchronous readLine) next+   Async.bindT readLine next {- strict variant    do lineE <- readLine       maybe
src/Network/Monad/Reader.hs view
@@ -7,7 +7,7 @@  import qualified Network.Stream as Stream import Control.Monad.Trans.Reader (ReaderT, asks, )-import Control.Monad.Trans (lift, )+import Control.Monad.Trans.Class (lift, )  import qualified Control.Monad.Exception.Asynchronous as Async import qualified Control.Monad.Exception.Synchronous  as Sync@@ -16,24 +16,26 @@  type T body m = ReaderT (Transfer.T m body) m -type SyncExceptional body m a =-   Sync.ExceptionalT Stream.ConnError (T body m) a+type SyncExceptional body m =+   Sync.ExceptionalT Stream.ConnError (T body m) -type AsyncExceptional body m a =-   (T body m) (Async.Exceptional Stream.ConnError a)+type AsyncExceptional body m =+   Async.ExceptionalT Stream.ConnError (T body m)   {-# INLINE readLine #-} readLine :: (Monad m) => AsyncExceptional body m body readLine =+   Async.ExceptionalT $    do action <- asks Transfer.readLine-      lift action+      lift $ Async.runExceptionalT action  {-# INLINE readBlock #-} readBlock :: (Monad m) => Int -> AsyncExceptional body m body readBlock n =+   Async.ExceptionalT $    do action <- asks Transfer.readBlock-      lift $ action n+      lift $ Async.runExceptionalT $ action n  {-# INLINE writeBlock #-} writeBlock :: (Monad m) => body -> SyncExceptional body m ()
src/Network/Monad/Transfer.hs view
@@ -18,21 +18,21 @@ module Network.Monad.Transfer where  import qualified Network.Stream as Stream-import Control.Monad.Trans (MonadIO(liftIO), )-import Control.Monad (liftM, )+import Control.Monad.IO.Class (MonadIO(liftIO), )  import qualified Control.Monad.Exception.Asynchronous as Async import qualified Control.Monad.Exception.Synchronous  as Sync+import Control.Applicative (WrappedMonad(WrapMonad), unwrapMonad, ) -import Data.Monoid (Monoid)+import Data.Monoid (Monoid, )    type SyncExceptional m =         Sync.ExceptionalT Stream.ConnError m -type AsyncExceptional m a =-        m (Async.Exceptional Stream.ConnError a)+type AsyncExceptional m =+        Async.ExceptionalT Stream.ConnError m  data T m body =    Cons {@@ -49,6 +49,16 @@  liftIOAsync :: (MonadIO io, Monoid a) =>    IO (Stream.Result a) -> AsyncExceptional io a-liftIOAsync m =-   liftM (Async.fromSynchronousMonoid . Sync.fromEither) $-   liftIO m+liftIOAsync =+   Async.mapExceptionalT unwrapMonad .+   Async.fromSynchronousMonoidT .+   Sync.mapExceptionalT WrapMonad .+   liftIOSync+{-+liftIOAsync =+   Async.ExceptionalT .+   liftM (Async.fromSynchronous mempty) .+   Sync.runExceptionalT .+   liftIOSync+-}+--   Async.fromSynchronousMonoidT . liftIOSync
src/Network/Monad/Transfer/ChunkyLazyIO.hs view
@@ -10,7 +10,6 @@  import qualified Network.TCP as TCP import Control.Monad.Trans.Reader (ReaderT, runReaderT, )-import Control.Monad (liftM, )  import qualified Control.Monad.Exception.Asynchronous as Async @@ -68,15 +67,14 @@  readBlockChunky :: (TCP.HStream body, Body body) =>    Int -> TCP.HandleStream body -> Int -> Transfer.AsyncExceptional LazyIO.T body-readBlockChunky chunkSize h n =+readBlockChunky chunkSize h =    let go todo =          if todo>0-           then -- we cannot use Async.appendM because 'length str' is needed-                do ~(Async.Exceptional e str) <--                      Transfer.liftIOAsync $-                      TCP.readBlock h (min chunkSize todo)-                   liftM (fmap (mappend str)) $-                      maybe (go (max 0 (todo - length str)))-                            (return . Async.throwMonoid) e-           else return $ Async.pure mempty-   in  go n+           then -- we cannot use 'mappend' because 'length str' is needed+                do (Transfer.liftIOAsync $+                    TCP.readBlock h (min chunkSize todo))+                   `Async.bindT`+                   (\str ->+                       fmap (mappend str) $ go (max 0 (todo - length str)))+           else mempty+   in  go
src/Network/Monad/Transfer/IO.hs view
@@ -5,7 +5,7 @@  import qualified Network.TCP as TCP import Control.Monad.Trans.Reader (ReaderT, runReaderT, )-import Control.Monad.Trans (MonadIO, )+import Control.Monad.IO.Class (MonadIO, )  import Data.Monoid (Monoid, )
src/Network/Monad/Transfer/Offline.hs view
@@ -11,7 +11,7 @@ import qualified Network.Stream as Stream import Control.Monad.Trans.Reader (ReaderT, runReaderT, ) import Control.Monad.Trans.RWS    (RWS, runRWS, tell, )-import Control.Monad.Trans (lift, )+import Control.Monad.Trans.Class (lift, )  import qualified Control.Monad.Trans.RWS as RWS @@ -67,6 +67,7 @@    (body -> (a, body)) ->    Transfer.AsyncExceptional (T body) a withBuffer f =+   Async.ExceptionalT $    {-    It is important to run all monadic actions    independent from the exceptional case of an empty buffer,