packages feed

iterIO 0.1 → 0.2

raw patch · 14 files changed

+156/−119 lines, 14 filesdep ~HsOpenSSL

Dependency ranges changed: HsOpenSSL

Files

Data/IterIO.hs view
@@ -177,7 +177,7 @@ the lazy @'ByteString'@ format, which is more efficient than plain 'String's.  ('enumFile' supports multiple types, but in this example there is not enough information for Haskell to choose one of them, so-we must use 'enumfile'' or use @::@ to specify a type explicitly.)+we must use 'enumFile'' or use @::@ to specify a type explicitly.) Once again, '|$' is used to execute the IO actions, but, this time, the return value is just @()@; the interesting action lies in the side effects of writing data to standard output while iterating over the@@ -355,7 +355,7 @@     inumGrep :: (Monad m) => String -> 'Inum' [S.ByteString] [S.ByteString] m a     inumGrep re = `mkInum` $ do       line <- 'headI'-      if line =~ packedRe then return [line] else inumGrep re+      if line =~ packedRe then return [line] else return []         where           packedRe = S8.pack re @@@ -369,19 +369,6 @@                   Just _  -> count (n+1)                   Nothing -> return n @--Notice that when a line doesn't match, @inumGrep@ calls itself-recursively.  This is necessary because returning an empty list of-lines signals to 'mkInum' that there is no more input.  Thus, the-following code would cause our grep implementation to exit at the-first non-matching line:--@-      return $ if line =~ packedRe then [line] else []    -- Incorrect-@--(If you don't like this 'mempty'-means-EOF behavior, you can also wrap-the argument to 'mkInum' in the function 'whileNullI'.)  Now we are almost ready to assemble all the pieces.  But recall that the '|$' operator applies one 'Onum' to one 'Iter', yet now we have
Data/IterIO/Atto.hs view
@@ -1,12 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}  -- | This module contains an adapter function to run attoparsec -- 'Parser's from within the 'Iter' monad. module Data.IterIO.Atto where -import Control.Exception import Data.Attoparsec as A-import Data.Typeable import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S
Data/IterIO/Http.hs view
@@ -359,7 +359,8 @@                 <|> return (S8.pack "/")         query <- char '?' *> (strictify <$> whileI qpcharslash) <|> nil         return (path, query)-      qpcharslash c = rfc3986_test rfc3986_pcharslash c || c == eord '?'+      qpcharslash c = rfc3986_test rfc3986_pcharslash c+                      || c == eord '?' || c == eord '%'   -- | Returns (scheme, host, path, query) absUri :: (Monad m) => Iter L m (S, S, Maybe Int, S, S)@@ -404,7 +405,7 @@ --  -- | Data structure representing an HTTP request message.-data HttpReq = HttpReq {+data HttpReq s = HttpReq {       reqMethod :: !S.ByteString     -- ^ Method (e.g., GET, POST, ...).     , reqPath :: !S.ByteString@@ -446,9 +447,12 @@     , reqTransferEncoding :: ![S.ByteString]     -- ^ A list of the encodings in the Transfer-Encoding header.     , reqIfModifiedSince :: !(Maybe UTCTime)+    -- ^ Time from the If-Modified-Since header (if present)+    , reqSession :: s+    -- ^ Application-specific session information     } deriving (Typeable, Show) -defaultHttpReq :: HttpReq+defaultHttpReq :: HttpReq () defaultHttpReq = HttpReq { reqMethod = S.empty                          , reqPath = S.empty                          , reqPathLst = []@@ -464,6 +468,7 @@                          , reqContentLength = Nothing                          , reqTransferEncoding = []                          , reqIfModifiedSince = Nothing+                         , reqSession = ()                          }  -- | Returns a normalized version of the full requested path@@ -471,7 +476,7 @@ -- has been eliminated, @\"..\"@ has been processed, there is exactly -- one @\'/\'@ between each directory component, and the query has -- been stripped off).-reqNormalPath :: HttpReq -> S.ByteString+reqNormalPath :: HttpReq s -> S.ByteString reqNormalPath rq =     S.intercalate slash $ S.empty : reqPathCtx rq ++ reqPathLst rq     where slash = S8.singleton '/'@@ -487,7 +492,7 @@ -- | HTTP request line, defined by RFC2616 as: -- -- > Request-Line   = Method SP Request-URI SP HTTP-Version CRLF-request_line :: (Monad m) => Iter L m HttpReq+request_line :: (Monad m) => Iter L m (HttpReq ()) request_line = do   method <- strictify <$> while1I (isUpper . w2c)   spaces@@ -506,7 +511,7 @@                , reqVers = (major, minor)                } -request_headers :: (Monad m) => Map S (HttpReq -> Iter L m HttpReq)+request_headers :: (Monad m) => Map S (HttpReq a -> Iter L m (HttpReq a)) request_headers = Map.fromList $                   map (\(a, b) -> (S8.map toLower $ S8.pack a, b)) $     [@@ -518,13 +523,13 @@     , ("If-Modified-Since", if_modified_since_hdr)     ] -host_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+host_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) host_hdr req = do   (host, mport) <- hostI   return req { reqHost = host, reqPort = mport }  -- Cookie header (RFC 6265)-cookie_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+cookie_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) cookie_hdr req = ifParse cookiesI setCookies ignore   where     cookiesI = sepBy1 parameter sep <* eofI@@ -532,18 +537,18 @@     setCookies cookies = return $ req { reqCookies = cookies }     ignore = nullI >> return req -content_type_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+content_type_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) content_type_hdr req = do   typ <- token <++> char '/' <:> token   parms <- many $ olws >> char ';' >> parameter   return req { reqContentType = Just (typ, parms) } -content_length_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+content_length_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) content_length_hdr req = do   len <- olws >> (while1I (isDigit . w2c) >>= readI) <* olws   return req { reqContentLength = Just len } -transfer_encoding_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+transfer_encoding_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) transfer_encoding_hdr req = do   tclist <- many tc   return req { reqTransferEncoding = tclist }@@ -554,7 +559,7 @@       skipMany $ olws >> char ';' >> parameter       return coding -if_modified_since_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+if_modified_since_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) if_modified_since_hdr req = do   modtime <- dateI   return req { reqIfModifiedSince = Just modtime }@@ -568,7 +573,7 @@   crlf   return (field, val) -any_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+any_hdr :: (Monad m) => HttpReq s -> Iter L m (HttpReq s) any_hdr req = do   (field, val) <- hdr_field_val   let req' = req { reqHeaders = (field, val) : reqHeaders req }@@ -581,7 +586,7 @@       return r  -- | Parse an HTTP header, returning an 'HttpReq' data structure.-httpReqI :: Monad m => Iter L.ByteString m HttpReq+httpReqI :: Monad m => Iter L.ByteString m (HttpReq ()) httpReqI = do   -- Section 4.1 of RFC 2616:  "In the interest of robustness, servers   -- SHOULD ignore any empty line(s) received where a Request-Line is@@ -629,7 +634,7 @@ -- beyond) and decodes the Transfer-Encoding.  It handles straight -- content of a size specified by the Content-Length header and -- chunk-encoded content.-inumHttpBody :: (Monad m) => HttpReq -> Inum L.ByteString L.ByteString m a+inumHttpBody :: (Monad m) => HttpReq s -> Inum L.ByteString L.ByteString m a inumHttpBody req =     case reqTransferEncoding req of       lst | null lst || lst == [S8.pack "identity"] ->@@ -727,7 +732,7 @@ -- called from within an 'inumHttpBody' enumerator (which is -- guaranteed by 'inumHttpServer'). foldForm :: (Monad m) =>-            HttpReq+            HttpReq s          -> (a -> FormField -> Iter L.ByteString m a)          -> a          -> Iter L.ByteString m a@@ -813,11 +818,11 @@     char '&' \/ return a $ \_ -> foldControls f a  foldUrlencoded :: (Monad m) =>-                  HttpReq -> (a -> FormField -> Iter L m a) -> a -> Iter L m a+                  HttpReq s -> (a -> FormField -> Iter L m a) -> a -> Iter L m a foldUrlencoded _req f z = foldControls f z  foldQuery :: (Monad m) =>-             HttpReq -> (a -> FormField -> Iter L m a) -> a -> Iter L m a+             HttpReq s -> (a -> FormField -> Iter L m a) -> a -> Iter L m a foldQuery req f z = inumPure (L.fromChunks [reqQuery req]) .| foldControls f z  --@@ -844,13 +849,13 @@ multipart :: S multipart = S8.pack "multipart/form-data" -reqBoundary :: HttpReq -> Maybe S+reqBoundary :: HttpReq s -> Maybe S reqBoundary req = case reqContentType req of                     Just (typ, parms) | typ == multipart ->                                           lookup (S8.pack "boundary") parms                     _ -> Nothing -multipartI :: (Monad m) => HttpReq -> Iter L m (Maybe (FormField))+multipartI :: (Monad m) => HttpReq s -> Iter L m (Maybe (FormField)) multipartI req = case reqBoundary req of                    Just b  -> findpart $ S8.pack "--" `S8.append` b                    Nothing -> return Nothing@@ -876,7 +881,7 @@                  , ffHeaders = cdhdr:hdrs                  } -inumMultipart :: (Monad m) => HttpReq -> Inum L L m a+inumMultipart :: (Monad m) => HttpReq s -> Inum L L m a inumMultipart req iter = flip mkInumM (iter <* nullI) $ do   b <- bstr   ipipe $ inumStopString b@@ -887,7 +892,7 @@                Nothing -> throwParseI "inumMultipart: no parts"  foldMultipart :: (Monad m) =>-                 HttpReq -> (a -> FormField -> Iter L m a) -> a -> Iter L m a+                 HttpReq s -> (a -> FormField -> Iter L m a) -> a -> Iter L m a foldMultipart req f z = multipartI req >>= doPart     where       doPart Nothing = return z@@ -1073,7 +1078,7 @@                  , L8.pack "\">here</A>.</P>\n"]  -- | Generate a 403 (forbidden) response.-resp403 :: (Monad m) => HttpReq -> HttpResp m+resp403 :: (Monad m) => HttpReq s -> HttpResp m resp403 req = mkHtmlResp stat403 html     where html = L8.concat                  [L8.pack@@ -1088,7 +1093,7 @@                            \</BODY></HTML>\n"]  -- | Generate a 404 (not found) response.-resp404 :: (Monad m) => HttpReq -> HttpResp m+resp404 :: (Monad m) => HttpReq s -> HttpResp m resp404 req = mkHtmlResp stat404 html     where html = L8.concat                  [L8.pack@@ -1103,7 +1108,7 @@                            \</BODY></HTML>\n"]  -- | Generate a 405 (method not allowed) response.-resp405 :: (Monad m) => HttpReq -> HttpResp m+resp405 :: (Monad m) => HttpReq s -> HttpResp m resp405 req = mkHtmlResp stat405 html     where html = L8.concat                  [L8.pack@@ -1152,19 +1157,19 @@  -- | Given the headers of an HTTP request, provides an iteratee that -- will process the request body (if any) and return a response.-type HttpRequestHandler m = HttpReq -> Iter L.ByteString m (HttpResp m)+type HttpRequestHandler m s = HttpReq s -> Iter L.ByteString m (HttpResp m)  -- | Data structure describing the configuration of an HTTP server for -- 'inumHttpServer'. data HttpServerConf m = HttpServerConf {       srvLogger :: !(String -> Iter L.ByteString m ())     , srvDate :: !(Iter L.ByteString m (Maybe UTCTime))-    , srvHandler :: !(HttpRequestHandler m)+    , srvHandler :: !(HttpRequestHandler m ())     }  -- | Generate a null 'HttpServerConf' structure with no logging and no -- Date header.-nullHttpServer :: (Monad m) => HttpRequestHandler m -> HttpServerConf m+nullHttpServer :: (Monad m) => HttpRequestHandler m () -> HttpServerConf m nullHttpServer handler = HttpServerConf {                            srvLogger = const $ return ()                          , srvDate = return Nothing@@ -1173,7 +1178,7 @@  -- | Generate an 'HttpServerConf' structure that uses IO calls to log to -- standard error and get the current time for the Date header.-ioHttpServer :: (MonadIO m) => HttpRequestHandler m -> HttpServerConf m+ioHttpServer :: (MonadIO m) => HttpRequestHandler m () -> HttpServerConf m ioHttpServer handler = HttpServerConf {                          srvLogger = liftIO . hPutStrLn stderr                        , srvDate = liftIO $ Just `liftM` getCurrentTime
Data/IterIO/HttpRoute.hs view
@@ -4,7 +4,7 @@     , runHttpRoute, addHeader     , routeConst, routeFn, routeReq     , routeMethod, routeHost, routeTop-    , HttpMap, routeMap, routeMap', routeName, routePath, routeVar+    , HttpMap, routeMap, routeAlwaysMap, routeName, routePath, routeVar     , mimeTypesI, dirRedir, routeFileSys, FileSystemCalls(..), routeGenFileSys     ) where @@ -64,19 +64,19 @@ -- be served out of the file system under the @\"\/var\/www\/htdocs\"@ -- directory.  (This example assumes @mimeMap@ has been constructed as -- discussed for 'mimeTypesI'.)-newtype HttpRoute m =-    HttpRoute (HttpReq -> Maybe (Iter L.ByteString m (HttpResp m)))+newtype HttpRoute m s =+    HttpRoute (HttpReq s -> Maybe (Iter L.ByteString m (HttpResp m)))  runHttpRoute :: (Monad m) =>-                HttpRoute m -> HttpReq -> Iter L.ByteString m (HttpResp m)+                HttpRoute m s -> HttpReq s -> Iter L.ByteString m (HttpResp m) runHttpRoute (HttpRoute route) rq = fromMaybe (return $ resp404 rq) $ route rq -instance Monoid (HttpRoute m) where+instance Monoid (HttpRoute m s) where     mempty = HttpRoute $ const Nothing     mappend (HttpRoute a) (HttpRoute b) =         HttpRoute $ \req -> a req `mplus` b req -popPath :: Bool -> HttpReq -> HttpReq+popPath :: Bool -> HttpReq s -> HttpReq s popPath isParm req =     case reqPathLst req of       h:t -> req { reqPathLst = t@@ -94,19 +94,19 @@ --   addHeader ('S8.pack' \"Cache-control: max-age=3600\") $ --       'routeFileSys' mime ('dirRedir' \"index.html\") \"\/var\/www\/htdocs\" -- @-addHeader :: (Monad m) => S8.ByteString -> HttpRoute m -> HttpRoute m+addHeader :: (Monad m) => S8.ByteString -> HttpRoute m s -> HttpRoute m s addHeader h (HttpRoute r) = HttpRoute $ \req -> liftM (liftM addit) (r req)     where addit resp = resp { respHeaders = h : respHeaders resp }  -- | Route all requests to a constant response action that does not -- depend on the request.  This route always succeeds, so anything -- 'mappend'ed will never be used.-routeConst :: (Monad m) => HttpResp m -> HttpRoute m+routeConst :: (Monad m) => HttpResp m -> HttpRoute m s routeConst resp = HttpRoute $ const $ Just $ return resp  -- | Route all requests to a particular function.  This route always -- succeeds, so anything 'mappend'ed will never be used.-routeFn :: (HttpReq -> Iter L.ByteString m (HttpResp m)) -> HttpRoute m+routeFn :: (HttpReq s -> Iter L.ByteString m (HttpResp m)) -> HttpRoute m s routeFn fn = HttpRoute $ Just . fn  -- | Select a route based on some arbitrary function of the request.@@ -131,14 +131,14 @@ --                                                      to rest of myRoute -} --            _ -> 'routeConst' $ 'resp405' req  {- reject request -} -- @-routeReq :: (HttpReq -> HttpRoute m) -> HttpRoute m+routeReq :: (HttpReq s -> HttpRoute m s) -> HttpRoute m s routeReq fn = HttpRoute $ \req ->                 let (HttpRoute route) = fn req                 in route req   -- | Route the root directory (/).-routeTop :: HttpRoute m -> HttpRoute m+routeTop :: HttpRoute m s -> HttpRoute m s routeTop (HttpRoute route) = HttpRoute $ \req ->                              if null $ reqPathLst req then route req                              else Nothing@@ -146,8 +146,8 @@ -- | Route requests whose \"Host:\" header matches a particular -- string. routeHost :: String -- ^ String to compare against host (must be lower-case)-          -> HttpRoute m   -- ^ Target route to follow if host matches-          -> HttpRoute m+          -> HttpRoute m s -- ^ Target route to follow if host matches+          -> HttpRoute m s routeHost host (HttpRoute route) = HttpRoute check     where shost = S8.pack $ map toLower host           check req | reqHost req /= shost = Nothing@@ -155,30 +155,22 @@  -- | Route based on the method (GET, POST, HEAD, etc.) in a request. routeMethod :: String           -- ^ String method should match-            -> HttpRoute m      -- ^ Target route to take if method matches-            -> HttpRoute m+            -> HttpRoute m s    -- ^ Target route to take if method matches+            -> HttpRoute m s routeMethod method (HttpRoute route) = HttpRoute check     where smethod = S8.pack method           check req | reqMethod req /= smethod = Nothing                     | otherwise                = route req  -- | Type alias for the argument of 'routeMap'.-type HttpMap m = [(String, HttpRoute m)]+type HttpMap m s = [(String, HttpRoute m s)]  -- | @routeMap@ builds an efficient map out of a list of--- @(directory_name, 'HttpRoute')@ pairs.  It matches all requests and--- returns a 404 error if there is a request for a name not present in--- the map.-routeMap :: (Monad m) => HttpMap m -> HttpRoute m-routeMap lst = routeMap' lst `mappend` routeFn (return . resp404)---- | @routeMap'@ is like @routeMap@, but only matches names that exist--- in the map.  Thus, multiple @routeMap'@ results can be combined--- with 'mappend'.  By contrast, combining @routeMap@ results with--- 'mappend' is useless--the first one will match all requests (and--- return a 404 error for names that do not appear in the map).-routeMap' :: HttpMap m -> HttpRoute m-routeMap' lst = HttpRoute check+-- @(directory_name, 'HttpRoute')@ pairs.  If a name is not in the+-- map, the request is not matched.  Note that only the next directory+-- component in the URL is matched.+routeMap :: HttpMap m s -> HttpRoute m s+routeMap lst = HttpRoute check     where       check req = case reqPathLst req of                     h:_ -> maybe Nothing@@ -189,9 +181,14 @@       rmap = Map.fromListWithKey nocombine $ map packfirst lst       nocombine k _ _ = error $ "routeMap: duplicate key for " ++ S8.unpack k +-- | @routeAlwaysMap@ is like @routeMap@, but matches all requests and+-- returns a 404 error for names that do not appear in the map.+routeAlwaysMap :: (Monad m) => HttpMap m s -> HttpRoute m s+routeAlwaysMap lst = routeMap lst `mappend` routeFn (return . resp404)+ -- | Routes a specific directory name, like 'routeMap' for a singleton -- map.-routeName :: String -> HttpRoute m -> HttpRoute m+routeName :: String -> HttpRoute m s -> HttpRoute m s routeName name (HttpRoute route) = HttpRoute check     where sname = S8.pack name           headok (h:_) | h == sname = True@@ -201,7 +198,7 @@  -- | Routes a specific path, like 'routeName', except that the path -- can include several directories.-routePath :: String -> HttpRoute m -> HttpRoute m+routePath :: String -> HttpRoute m s -> HttpRoute m s routePath path route = foldr routeName route dirs     where dirs = case splitDirectories path of                    "/":t -> t@@ -211,7 +208,7 @@ -- front of the 'reqPathParams' list in the 'HttpReq' structure.  This -- allows the name to serve as a variable argument to the eventual -- handling function.-routeVar :: HttpRoute m -> HttpRoute m+routeVar :: HttpRoute m s -> HttpRoute m s routeVar (HttpRoute route) = HttpRoute check     where check req = case reqPathLst req of                         _:_ -> route $ popPath True req@@ -293,7 +290,7 @@  -- | @dirRedir indexFileName@ redirects requests to the URL formed by -- appending @\"/\" ++ indexFileName@ to the requested URL.-dirRedir :: (Monad m) => FilePath -> FilePath -> HttpRoute m+dirRedir :: (Monad m) => FilePath -> FilePath -> HttpRoute m s dirRedir index _path = routeFn $ \req -> return $                        resp301 $ S8.unpack (reqNormalPath req) ++ '/':index @@ -307,7 +304,7 @@ routeFileSys :: (MonadIO m) =>                 (String -> S8.ByteString)              -- ^ Map of file suffixes to mime types (see 'mimeTypesI')-             -> (FilePath -> HttpRoute m)+             -> (FilePath -> HttpRoute m s)              -- ^ Handler to invoke when the URL maps to a directory              -- in the file system.  Reasonable options include:              --@@ -322,7 +319,7 @@              -- request directly to an index file.              -> FilePath              -- ^ Pathname of directory to serve from file system-             -> HttpRoute m+             -> HttpRoute m s routeFileSys = routeGenFileSys defaultFileSystemCalls  -- | A generalized version of 'routeFileSys' that takes a@@ -332,9 +329,9 @@ routeGenFileSys :: (Monad m) =>                    FileSystemCalls h m                 -> (String -> S8.ByteString)-                -> (FilePath -> HttpRoute m)+                -> (FilePath -> HttpRoute m s)                 -> FilePath-                -> HttpRoute m+                -> HttpRoute m s routeGenFileSys fs typemap index dir0 = HttpRoute $ Just . check     where       dir = if null dir0 then "." else dir0
Data/IterIO/Inum.hs view
@@ -91,7 +91,12 @@ -- 'mkInumM' functions, which hide most of the error handling details -- and ensure the above rules are obeyed.  Most @Inum@s are -- polymorphic in the last type, @a@, in order to work with iteratees--- returning any type.+-- returning any type.  There isn't much reason for an @Inum@ to care+-- about the type @a@.  Had this module used the Rank2Types Haskell+-- extension, it would define @Inum@ as:+--+-- > type Inum tIn tOut m = forall a. Iter tOut m a+-- >                               -> Iter tIn m (IterR tOut m a) type Inum tIn tOut m a = Iter tOut m a -> Iter tIn m (IterR tOut m a)  -- | An @Onum t m a@ is just an 'Inum' in which the input is@@ -493,7 +498,7 @@         -> CtlHandler (Iter tIn mIn) t m a         -> CtlHandler (Iter tIn mIn) t m a consCtl fn fallback ca@(CtlArg a0 n c) = maybe (fallback ca) runfn $ cast a0-    where runfn a = fn a (n . fromJust . cast) c+    where runfn a = fn a (n . CtlDone . fromJust . cast) c                     `catchI` \e _ -> return $ runIter (n $ CtlFail e) c infixr 9 `consCtl` @@ -575,12 +580,22 @@  -- | Create a stateless 'Inum' from a \"codec\" 'Iter' that transcodes -- the input type to the output type.  The codec is invoked repeately--- until one of the following occurs:  The codec returns 'null' data,--- the codec throws an exception, or the underlying target 'Iter' is--- no longer active.  If the codec throws an exception of type--- 'IterEOF', this is considered normal termination and the error is--- not further propagated.+-- until one of the following occurs: --+--   1. The input is at an EOF marker AND the codec returns 'null'+--      data.  ('Onum's are always fed EOF, but other 'Inum's might+--      have reason to return 'mempty' data.)+--+--   2. The codec throws an exception.  If the exception is an EOF+--      exception--thrown either by 'throwEOFI', or by some IO action+--      inside 'liftIO'--this is considered normal termination, and is+--      the normal way for a codec to cause the 'Inum' to return.  If+--      the exception is of any other type, then the 'Inum' will+--      further propagate the exception as an 'Inum' failure.+--+--   3. The underlying target 'Iter' either returns a result or throws+--      an exception.+-- -- @mkInumC@ requires two other arguments before the codec.  First, a -- 'ResidHandler' allows residual data to be adjusted between the -- input and output 'Iter' monads.  Second, a 'CtlHandler' specifies a@@ -606,8 +621,9 @@       doIter iter = tryEOFI codec >>= maybe (return $ IterF iter) (doInput iter)       doInput iter input = do         r <- runIterMC ch iter (Chunk input False)+        eof <- Iter $ \c@(Chunk t eof) -> Done (eof && null t) c         case r of-          (IterF i) | not (null input) -> doIter i+          (IterF i) | not (eof && null input) -> doIter i           _ | isIterActive r -> return r           _ -> withResidHandler adj (getResid r) $ return . setResid r
Data/IterIO/Iter.hs view
@@ -16,13 +16,13 @@     , IterCUnsupp(..)     -- * Exception-related functions     , throwI, throwEOFI, throwParseI-    , catchI, tryI, tryFI, tryRI, tryEOFI+    , catchI, catchPI, tryI, tryFI, tryRI, tryEOFI     , finallyI, onExceptionI     , tryBI, tryFBI     , ifParse, ifNoParse, multiParse     -- * Some basic Iters     , nullI, data0I, dataI, pureI, chunkI-    , whileNullI, peekI, atEOFI, ungetI+    , someI, whileNullI, peekI, atEOFI, ungetI     , safeCtlI, ctlI     -- * Internal functions     , onDone, fmapI@@ -564,6 +564,18 @@ {-# INLINE catchI #-} catchI iter handler = genCatchI iter handler id +-- | Like catchI, but catches only what are considered to be parse+-- errors--that is, every constructor of 'IterFail' except+-- 'IterException'.+catchPI :: (ChunkData t, Monad m) =>+           Iter t m a+        -> (IterFail -> Iter t m a)+        -> Iter t m a+catchPI iter handler = tryRI iter >>= either failed return+    where failed r@(Fail (IterException _) _ _) = reRunIter r+          failed (Fail ifail _ _)               = handler ifail+          failed _                              = error "catchPI"+ -- | If an 'Iter' succeeds and returns @a@, returns @'Right' a@.  If -- the 'Iter' fails and throws an exception @e@ (of type @e@), returns -- @'Left' (e, r)@ where @r@ is the state of the failing 'Iter'.@@ -762,8 +774,8 @@ -- use: -- -- @---   total = parseAndSumIntegerList ``catchI`` handler---       where handler \('IterNoParse' _) _ = return -1+--   total = parseAndSumIntegerList ``catchPI`` handler+--       where handler _ = return -1 -- @ -- -- This last definition of @total@ may leave the input in some@@ -856,6 +868,21 @@ chunkI :: (Monad m, ChunkData t) => Iter t m (Chunk t) {-# INLINE chunkI #-} chunkI = iterF $ \c@(Chunk _ eof) -> Done c (Chunk mempty eof)++-- | Run an 'Iter' returning data of class 'ChunkData' and throw an+-- EOF exception if the data is 'null'.  (Note that this is different+-- from the @'some'@ method of the @'Alternative'@ class in+-- "Control.Applicative", which executes a computation one /or more/+-- times.  The iterIO library does not use @'Alternative'@, in part+-- because @`Alternative`@'s @\<|\>@ operator has left rather than+-- right fixity, which would make parsing less efficient.  See+-- "Data.IterIO.Parse" for information about iterIO's @\<|\>@+-- operator.)+someI :: (ChunkData tOut, Monad m) =>+         Iter tIn m tOut -> Iter tIn m tOut+someI = (>>= check)+    where check tOut | null tOut = throwEOFI "someI"+                     | otherwise = return tOut  -- | Keep running an 'Iter' until either its output is not 'null' or -- we have reached EOF.  Return the the `Iter`'s value on the last
Data/IterIO/ListLike.hs view
@@ -472,7 +472,9 @@ -- reading) and an 'Iter' (for writing).  Uses 'pairFinalizer' to -- 'hClose' the 'Handle' when both the 'Iter' and 'Onum' are finished. -- Puts the handle into binary mode, but does not change the--- buffering.+-- buffering.  As mentioned for 'handleI', Haskell's default buffering+-- can cause problems for many network protocols.  Hence, you may wish+-- to call @'hSetBuffering' h 'NoBuffering'@ before @iterHandle h@. iterHandle :: (LL.ListLikeIO t e, ChunkData t, MonadIO m) =>               Handle -> IO (Iter t m (), Onum t m a) iterHandle h = do
Data/IterIO/Parse.hs view
@@ -5,7 +5,7 @@  module Data.IterIO.Parse (-- * Iteratee combinators                           (<|>), (\/), orEmpty, (<?>), expectedI-                         , someI, foldrI, foldr1I, foldrMinMaxI+                         , foldrI, foldr1I, foldrMinMaxI                          , foldlI, foldl1I, foldMI, foldM1I                          , skipI, optionalI, ensureI                          , eord@@ -187,18 +187,6 @@           -> Iter t m a expectedI saw target =     Iter $ \_ -> Fail (IterExpected [(saw, target)]) Nothing Nothing---- | Takes an 'Iter' returning a 'LL.ListLike' type, executes the--- 'Iter' once, and throws a parse error if the returned value is--- 'LL.null'.  (Note that this is quite different from the @'some'@--- method of the @'Alternative'@ class in "Control.Applicative", which--- executes a computation one /or more/ times.  This library does not--- use @'Alternative'@ because @`Alternative`@'s @\<|\>@ operator has--- left instead of right fixity.)-someI :: (ChunkData t, Monad m, LL.ListLike a e) => Iter t m a -> Iter t m a-someI iter = (<?> "someI") $ do-  a <- iter-  if LL.null a then mzero else return a  -- | Repeatedly invoke an 'Iter' and right-fold a function over the -- results.
Data/IterIO/SSL.hs view
@@ -33,7 +33,7 @@ enumSsl :: (MonadIO m) => SSL.SSL -> Onum L.ByteString m a enumSsl ssl = mkInumC id ch codec     where ch = mkCtl (\SslC -> return $ SslConnection ssl)-               `consCtl` (socketCtl $ SSL.sslSocket ssl)+               `consCtl` (maybe noCtl socketCtl $ SSL.sslSocket ssl)           codec = do buf <- liftIO (SSL.read ssl L.defaultChunkSize)                      if S.null buf                        then return L.empty
Data/IterIO/Search.hs view
@@ -60,9 +60,11 @@     where       (ltmap, ma, _) = Map.splitLookup t mp       (k, v) = Map.findMax ltmap+      kIsGood = not (Map.null ltmap) && k `LL.isPrefixOf` t       p = longestCommonPrefix k t       ckprefix | Map.null mp || LL.null t = Nothing-               | k `LL.isPrefixOf` t      = Just (k, v)+               -- XXX LL.null t case above is redundant, maybe remove?+               | kIsGood                  = Just (k, v)                | otherwise                = findLongestPrefix ltmap p  -- | Reads input until it can uniquely determine the longest key in a
Examples/fgrep.hs view
@@ -19,7 +19,7 @@ filterLines s = mkInum loop     where       loop = do line <- lineI-                if match line then return [line] else loop+                if match line then return [line] else return []       ls = L8.pack s       match l | L.null l  = False               | otherwise = L.isPrefixOf ls l || match (L.tail l)
Examples/httptest.hs view
@@ -60,16 +60,16 @@                                if exist then return h else findMimeTypes t       findMimeTypes []    = return "mime.types" -- cause error -routeFS :: (MonadIO m) => FilePath -> HttpRoute m+routeFS :: (MonadIO m) => FilePath -> HttpRoute m s routeFS = routeFileSys mimeMap (dirRedir "index.html")  cabal_dir :: String cabal_dir = (unsafePerformIO $ getAppUserDataDirectory "cabal") ++ "/share/doc" -route :: (MonadIO m) => HttpRoute m+route :: (MonadIO m) => HttpRoute m () route = mconcat         [ routeTop $ routeConst $ resp301 "/cabal"-        , routeMap' [ ("cabal", routeConst $ resp301 cabal_dir)+        , routeMap [ ("cabal", routeConst $ resp301 cabal_dir)                     , ("static", routeFS "static") -- directory ./static                     , ("favicon.ico"                       -- serve /favicon.ico from file ./static/favicon.ico,
+ NEWS view
@@ -0,0 +1,16 @@++* Changes in release 0.2++Updated to compile with HsOpenSSL 0.10.1, which has incompatible+sslSocket function.++A few bugs were fixed, including one in ctlCons, and another in HTTP+cookie parsing.++The HTTPReq type is now parameterized by session state.++mkInumC (and mkInum, mkInumP) no longer consider a null codec result+to terminate the 'Inum' unless the input is at an EOF condition.  This+allows inums to propagate mempty Chunks inwards, which could+conceivably be useful for situations in which inumNull lets an Iter+call liftIO to unblock an enclosing Onum.
iterIO.cabal view
@@ -1,6 +1,6 @@ Name:           iterIO Homepage:       http://www.scs.stanford.edu/~dm/iterIO-Version:        0.1+Version:        0.2 Cabal-version:  >= 1.6 build-type:     Simple License:        BSD3@@ -11,7 +11,7 @@ Category:       System, Data, Enumerator Synopsis:       Iteratee-based IO with pipe operators Extra-source-files:-        GNUmakefile, README,+        GNUmakefile, README, NEWS,         Examples/fgrep.hs, Examples/zpipe.hs, Examples/httptest.hs  Description:@@ -64,7 +64,7 @@                  bytestring >= 0.9 && < 2,                  containers >= 0.3 && < 2,                  filepath >= 1.2 && < 2,-                 HsOpenSSL >= 0.8 && < 2,+                 HsOpenSSL >= 0.10.1 && < 2,                  ListLike >= 1.0 && < 4,                  mtl >= 1.1.0.2 && < 3,                  network >= 2.3 && < 3,