iterIO (empty) → 0.1

raw patch · 22 files changed

+7504/−0 lines, 22 filesdep +HsOpenSSLdep +ListLikedep +arraysetup-changed

Dependencies added: HsOpenSSL, ListLike, array, attoparsec, base, bytestring, containers, filepath, mtl, network, old-locale, process, stringsearch, time, unix

Files

• Data/IterIO.hs +933/−0
• Data/IterIO/Atto.hs +52/−0
• Data/IterIO/Extra.hs +223/−0
• Data/IterIO/Http.hs +1333/−0
• Data/IterIO/HttpRoute.hs +380/−0
• Data/IterIO/Inum.hs +1114/−0
• Data/IterIO/Iter.hs +1020/−0
• Data/IterIO/ListLike.hs +487/−0
• Data/IterIO/Parse.hs +561/−0
• Data/IterIO/SSL.hs +100/−0
• Data/IterIO/Search.hs +114/−0
• Data/IterIO/Trans.hs +394/−0
• Data/IterIO/Zlib.hs +261/−0
• Data/IterIO/ZlibInt.hsc +124/−0
• Examples/fgrep.hs +59/−0
• Examples/httptest.hs +115/−0
• Examples/zpipe.hs +24/−0
• GNUmakefile +68/−0
• LICENSE +29/−0
• README +11/−0
• Setup.hs +3/−0
• iterIO.cabal +99/−0

@@ -0,0 +1,933 @@++{- |++This is the main module to import for the IterIO package.  It+re-exports several other modules and mostly consists of+documentation--first a high-level overview of the iteratee model, then+a more detailed tutorial, finally a discussion of the differences from+other iteratee packages and acknowledgments.++See the "Data.IterIO.Iter", "Data.IterIO.Inum", and+"Data.IterIO.ListLike" modules for more detailed documentation of data+structures and functions.  In addition, "Data.IterIO.Trans" (also+re-exported by this module) supplies functions that help you invoke+monad transformers from the mtl library from within the 'Iter' monad.++Several other potentially useful modules in the package are not+exported by default:++ * "Data.IterIO.Parse" includes parsec-like parsing combinators for+   iteratee input.++ * "Data.IterIO.Zlib" provides zlib and gzip format compression and+   decompression.++ * "Data.IterIO.SSL" provides support for SSL.++ * "Data.IterIO.Http" provides support for parsing and formatting+   HTTP, including handling form and file uploads (which can be+   processed in constant space).  This may be useful in conjunction+   with "Data.IterIO.HttpRoute", which provides simple request routing+   support for web servers.++ * "Data.IterIO.Atto" provides support for running attoparsec parsers+   on iteratee input (see+   <http://hackage.haskell.org/package/attoparsec/>).++ * "Data.IterIO.Extra" provides debugging functions, as well as a+   loopback iteratee that can be used to test a protocol+   implementation against itself.++-}++module Data.IterIO+    (module Data.IterIO.Iter+    , module Data.IterIO.Trans+    , module Data.IterIO.Inum+    , module Data.IterIO.ListLike++    -- * Overview+    -- $Overview++    -- * Tutorial+    -- $Tutorial++    -- * Differences from other iteratee packages+    -- $Differences++    -- * Acknowledgments+    -- $Acknowledgments+    ) where++import Data.IterIO.Iter hiding (null, run -- names that might collide+                               )+import Data.IterIO.Trans+import Data.IterIO.Inum+import Data.IterIO.ListLike++{- $Overview++   At a high level, an iteratee is a data sink that is fed chunks of+   data.  It may return a useful result, or its utility may lie in+   monadic side-effects, such as storing received data to a file.+   Iteratees are represented by the type @'Iter' t m a@.  Here @t@ is+   the type of data that the iteratee receives as input.  (@t@ must be+   an instance of 'ChunkData', such as 'String' or lazy @ByteString@.)+   @m@ is the 'Monad' in which the iteratee runs--for instance 'IO'+   (or an instance of 'MonadIO') for the iteratee to perform IO.  @a@+   is the type that the iteratee will return when it has consumed+   enough input to produce a result.++   An enumerator is a data source that feeds data chunks to an+   iteratee.  Enumerators are also iteratees.  We use the type @'Inum'+   tIn tOut m a@ to represent these /iteratee-enumerators/.  As an+   iteratee, an 'Inum' sinks data of some input type, generally+   designated @tIn@.  As an enumerator, the 'Inum' feeds data of a+   potentially different type, @tOut@, to another iteratee.  Thus, the+   'Inum' can be viewed as transcoding data from type @tIn@ to type+   @tOut@ for consumption by another iteratee.++   'Inum's are generally constructed using the functions @'mkInum'@+   and @'mkInumM'@ in module "Data.IterIO.Inum".  The first function+   uses a simple @'Iter' tIn m tOut@ to translate between input type+   @tIn@ and output type @tOut@.  The second function, @'mkInumM'@,+   allows construction of more complex 'Inum's.++   An important special kind of 'Inum' is an /outer enumerator/,+   which is just an 'Inum' with the void input type @()@.  Outer+   enumerators are sources of data.  Rather than transcode input+   data, they produce data from monadic actions (or from pure data+   in the case of 'inumPure').  The type 'Onum' represents outer+   enumerators and is a synonym for 'Inum' with an input type of+   @()@.++   To execute iteratee-based IO, you must apply an 'Onum' to an+   'Iter' with the '|$' (\"pipe apply\") binary operator.++   An important property of enumerators and iteratees is that they can+   be /fused/.  The '|.' (\"fuse leftward\") operator fuses two+   'Inum's together (provided the output type of the first is the+   input type of the second), yielding a new 'Inum' that transcodes+   from the input type of the first to the output type of the second.+   Similarly, the '.|' (\"fuse rightward\") operator fuses an 'Inum'+   to an 'Iter', yielding a new 'Iter' with a potentially different+   input type.++   Enumerators of the same type can also be /concatenated/, using+   the 'cat' function.  @enum1 ``cat`` enum2@ produces an enumerator+   whose effect is to feed first @enum1@'s data then @enum2@'s data+   to an 'Iter'.+-}++{- $Tutorial++#tutorial#++The iterIO library performs IO by hooking up sources of data, called+/enumerators/, to data sinks, called /iteratees/, in a manner+reminiscent of Unix command pipelines.  Compared to lazy IO, the+enumerator/iteratee paradigm provides better error handing,+referential transparency (which should, after all, be one of the big+advantages of Haskell), and equally convenient composition of protocol+layers and parsers without worrying about IO chunk boundaries.++Enumerators, implemented by the type 'Onum' (short for+/outer enumerator/, for reasons that will become clear below), are so+called because they enumerate all data elements (e.g., bytes or+packets) in some source such as a file or socket.  Hence, an+enumerator should be viewed as a /source/ outputting chunks of data+whose type is a @'Monoid'@.  (Actually, the input type must be of+class 'ChunkData', which is a @'Monoid'@ that additionally has a+method @'null'@ to test whether a piece of data is equal to+'mempty'.)++Iteratees, implemented by the type 'Iter', should be viewed as /sinks/+consuming data.  When executing IO, the library /iterates/ over all+data elements output by the source, using an iteratee to produce a+result.  The source may output data in chunks whose boundaries do not+coincide with logical message units; iteratees handle this+transparently, simplifying programming.++Here is a simple example:++@+    -- Return the first line of a file+    headFile :: FilePath -> IO String+    headFile path = 'enumFile' path '|$' 'lineI'+@++'enumFile' enumerates the contents of a file.  'lineI' returns a line+of input (discarding the newline).  '|$' is the /pipe apply/ operator+that applies an 'Onum' to an 'Iter', returning the result of the+'Iter'--in this case the first line of the file named @path@.++An `Iter`'s main purpose may not be to produce a result.  Some 'Iter's+are primarily useful for their side effects.  For example, 'stdoutI'+writes data to standard output; 'handleI' similarly writes output to+an arbitrary file handle.  Thus, the following function copies the+contents of a file to standard output:++@+    -- Copy file to standard output+    catFile :: FilePath -> IO ()+    catFile path = 'enumFile'' path '|$' 'stdoutI'+@++'enumFile'' is like 'enumFile' above, but type restricted to data in+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.)+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+input with 'stdoutI'.++The real power of the iteratee abstraction lies in the fact that+'Iter's are monadic computations.  One 'Iter' may invoke another to+make use of the first one's results.  Here is an example of a function+that returns the first two lines of a file:++@+    -- | Return first two lines of file+    head2File :: FilePath -> IO (String, String)+    head2File path = 'enumFile' path '|$' lines2I+@++@+    -- | Iter that returns next two lines as a pair+    lines2I :: (Monad m) => 'Iter' String m (String, String)+    lines2I = do+      line1 <- 'lineI'+      line2 <- 'lineI'+      return (line1, line2)+@++This example illustrates several points.  First, consider the type of+the @lines2I@ function:  @'Iter' String m (String, String)@.  The+'Iter' type constructor takes three type arguments.  The first,+'String' in this case, specifies the type of input expected by the+iteratee.  The last type, @(String, String)@ in this case, specifies+the result type of the iteratee.  Finally, the middle type, @m@, is a+monad, because @'Iter' t@ (for a given input type @t@) is a monad+transformer (i.e., it is an instance of the 'MonadTrans' class).  In+this case, when @head2File@ invokes @lines2I@, @m@ will be @IO@,+because @head2File@ is returning a result in the @IO@ monad.  However,+@lines2I@ would work equally well with any other monad.++Next, notice the functioning of @'Iter' String m@ as a monad.  The+type of 'lineI' in the above example is @'Iter' String m String@.  The+@lines2I@ function executes 'lineI' twice using monadic @do@ syntax to+bind the results to @line1@ and @line2@.  The monadic bind operator+hides the details of IO chunk boundaries.  If, for instance, 'lineI'+needs more input because a newline character has not yet been read,+'lineI' returns to the containing enumerator asking for more data.  If+the first 'lineI' receives more than a line of input, it simply passes+the residual input to the next invocation of 'lineI'.  Both of these+actions are hidden by the syntax, making most code much easier to read+and write.++That explains the iteratee type 'Iter'.  The enumerator type, 'Onum',+has the same three type arguments.  Thus, the type of 'enumFile', as+instantiated in the above examples, is @'enumFile' :: 'Onum' String IO+a@.  Most 'Onum' types are polymorphic in the last argument, so as to+be able to return whatever type the 'Iter' is returning.  (In fact,+'enumFile' is polymorphic in the first two arguments, too, so as to+work with multiple @String@-like types and any monad in the+@'MonadIO'@ class.)++Here is an example of an 'Iter' with side effects:++@+    liftIOexampleI :: (MonadIO m) => 'Iter' String m ()+    liftIOexampleI = do+      line <- 'lineI'+      'liftIO' $ putStrLn $ \"First line is: \" ++ line+      next <- 'takeI' 40+      'liftIO' $ putStrLn $ \"And the next 40 bytes are: \" ++ next+@++Unlike @lines2I@, @liftIOexampleI@ does not return any interesting+result, but it uses the @'liftIO'@ monad transformer method to output+the first line of the file, followed by the next 40 bytes.  The+'takeI' iteratee returns a 'String' (or @ByteString@) with exactly the+requested number of characters or bytes, unless an EOF (end-of-file)+is encountered.++Of course, the real power of command pipelines is that you can hook+multiple commands together.  For instance, say you want to know how+many words in the system dictionary files contain a double k and start+with a lower-case letter.  You could run a command like this:++>    cat /usr/share/dict/words /usr/share/dict/extra.words \+>        | grep kk | grep '^[a-z]' | wc -l++Let's see how to do something equivalent with iteratees, starting with+the @wc -l@ command, which counts lines.  Here is an equivalent iteratee:++@+    lineCountI :: (Monad m) => 'Iter' String m Int+    lineCountI = count 0+        where count n = do+                line <- 'safeLineI'+                case line of+                  Just _  -> count (n+1)+                  Nothing -> return n+@++The 'safeLineI' function is like 'lineI', but returns a @'Maybe'+'String'@ (or @'Maybe' 'ByteString'@) which is 'Nothing' upon an EOF+condition.  ('lineI' throws an exception on EOF.)++What about the @grep@ command?  @grep@ sits in the middle of a+pipeline, so it acts both as a data sink and as a data source.+This is why we call such a pipeline stage an+/iteratee-enumerator/, or 'Inum'.  Before defining our @grep@+equivalent, since multiple pipeline stages are going to be considering+the file one line at a time, let's first build an 'Inum' to separate+input into lines:++@+    import Data.ByteString as S+    import Data.ByteString.Char8 as S8+@++@+    -- | Break input into lines of type S.ByteString, as this type+    -- works most conveniently with regular expressions.  (Otherwise,+    -- we would prefer lazy ByteStrings.)+    inumToLines :: (Monad m) => 'Inum' S.ByteString [S.ByteString] m a+    inumToLines = 'mkInum' $ do+                    line <- 'lineI'+                    return [line]+@++'Inum' takes four type arguments, compared to only three for 'Onum'.+That's because an 'Inum' is acting as both an iteratee and an+enumerator; it needn't be processing the same type of data in both+roles.  In the above example, when acting as an iteratee,+@inumToLines@ consumes data of type @S.ByteString@ (the first type+argument), accepting one long stream of unstructured bytes.  However,+as an enumerator, @inumToLines@ produces output of type+@[S.ByteString]@ (the second type argument), a /list/ of strings, one+per line of the file.  In general the type @'Inum' tIn tOut m a@ is an+iteratee-enumerator taking input type @tIn@, producing output type+@tOut@, and feeding the output to an iteratee of type @'Iter' tOut m+a@.++In fact, an 'Onum' is just a special kind of 'Inum' with the void+input type @()@.  The type @'Onum' t m a@ is just a synonym for+@'Inum' () t m a@.  Most operations on 'Inum's can be used with+'Onum's as well, since an 'Onum' /is/ an 'Inum'.  The converse is not+true, however.  For example, the '|$' operator requires an 'Onum', as+it wouldn't know what data to feed to an arbitrary 'Inum'.  (If you+need it, however, there is a function @run@, hidden by this module but+exported by "Data.IterIO.Iter", that executes an iteratee computation+of arbitrary input type by feeding EOF as input.)++Iteratee-enumerators are generally constructed using either 'mkInum'+or `mkInumM`, and by convention most 'Inum's have names starting+\"@inum@...\", except that 'Onum' names start \"@enum@...\".  'mkInum'+takes an argument of type @'Iter' tIn m tOut@ that consumes input of+type @tIn@ to produce output of type @tOut@.  (For @inumToLines@,+@tIn@ is @S.ByteString@ and @tOut@ is @[S.ByteString]@).  This is fine+for simple stateless translation functions, but sometimes one would+like to keep state and use more complex logic in an 'Inum'.  For that,+the 'mkInumM' function creates an 'Inum' out of a computation in a+dedicated 'InumM' monad.  See the "Data.IterIO.Inum" documentation for+more information on 'mkInumM'.  In @inumToLines@, we do not need to+keep state.  We are happy just to let 'lineI' throw an exception on+EOF, which `mkInum` will catch and handle gracefully.++Throwing an EOF exception--either implicitly by executing another+'Iter', or explicitly with 'throwEOFI'--is one of the standard ways to+exit an 'Inum' created by 'mkInum'.  The other way is to return empty+input.++We similarly define an 'Inum' to filter out lines not matching a+regular expression (using the "Text.Regex.Posix.ByteString" library),+and a simple 'Inum' to count list elements (since @lineCountI ::+'Iter' String m Int@ has input data type @String@, while after+@inumToLines@ we need an 'Iter' with input data type+@[S.ByteString]@).++@+    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+        where+          packedRe = S8.pack re+@++@+    lengthI :: (Monad m) => 'Iter' [t] m Int+    lengthI = count 0+        where count n = do+                line <- 'safeHeadI'+                case line of+                  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+two 'Onum's (because we want to look through two files), and three+'Inum's that we want to compose into a pipeline.  The library+supports two types of composition for pipeline stages:+/concatenation/ and /fusing/.++Two 'Inum's (or 'Onum's) of the same type can be /concatenated/ with+the 'cat' function, producing a new data source that enumerates all of+the data in the first 'Inum' followed by all of the data in the+second.++There are two /fusing/ operators.  The left-associative '|.' operator+fuses two 'Inum's, provided the output type of the first is the input+type of the second.  (Mnemonic: it produces a pipeline stage that is+open on the right hand side, as it still needs to be applied to an+iteratee with '|$'.)  The right-associative '.|' operator fuses an+'Inum' to an 'Iter', producing a new 'Iter'.++The fusing operators bind more tightly than the infix concatenation+functions, which in turn bind more tightly than '|$'.  (Concatenation+operators can also be used through prefix function application, which+binds most tightly.)  Hence, putting it all together, we produce the+following Haskell equivalent to the above Unix pipeline:++@+    grepCount :: IO Int+    grepCount = 'enumFile' \"\/usr\/share\/dict\/words\" '|.' inumToLines+                    ``cat`` 'enumFile' \"\/usr\/share\/dict\/extra.words\" '|.' inumToLines+                '|$' inumGrep \"kk\"+                        '.|' inumGrep \"^[a-z]\"+                        '.|' lengthI+@++One often has a choice as to whether to fuse an 'Inum' to the+'Onum', or to the 'Iter'.  For example, @grepCount@ could+alternatively have been implemented as:++@+    grepCount' :: IO Int+    grepCount' = 'cat' ('enumFile' \"\/usr\/share\/dict\/words\" '|.' inumToLines)+                         ('enumFile' \"\/usr\/share\/dict\/extra.words\" '|.' inumToLines)+                    '|.' inumGrep \"kk\"+                    '|.' inumGrep \"^[a-z]\"+                 '|$' lengthI+@++In this case, the two are essentially equivalent.  However, for error+handling purposes, one should fuse together pipeline stages in which+errors have similar consequences.  Often an 'Inum' or 'Onum' failure+is less serious than an 'Iter' failure.  For example, in the above+example, if 'enumFile' fails because one of the files does not exist,+we might want to continue processing lines from the next file.+Conversely, if @lengthI@ fails or one of the @inumGrep@ stages fails+(most likely because the regular expression is illegal), there is not+much point in continuing the program.  This is why the first example+fused @inumGrep@ to @lengthI@, though this won't matter until we+actually handle errors (see below).++Another alternative would have been to swap the order of concatenation+and fusing:++@+    grepCount'' :: IO Int+    grepCount'' = 'cat' ('enumFile' \"\/usr\/share\/dict\/words\")+                           ('enumFile' \"\/usr\/share\/dict\/extra.words\")+                      '|.' inumToLines+                  '|$' inumGrep \"kk\"+                      '.|' inumGrep \"^[a-z]\"+                      '.|' lengthI+@++This last version changes the semantics of the counting slightly.+With @grepCount''@, if the first file has an incomplete last line,+this line will be merged with the first line of the second file, which+is probably not what you want.  (For instance, if the incomplete last+line of the first file starts with a capital letter, then the first+line of the second file will not be counted even if it starts with a+lower-case letter and contains two \"k\"s.)++One limitation of all the @grepCount@ variants shown so far is that if+the first file does not exist, the whole operation aborts.  This+might or might not be reasonable when counting lines, but in other+contexts we may want to resume after failure.  Suppose we want to+implement a function like the Unix @grep@ command that searches for a+string in a bunch of files and prints all matching lines.  If opening+or reading a file produces an error, the function should print the+error message and continue on with the next file.++Error handling is provided by the 'catchI' and 'inumCatch' functions,+which are roughly equivalent to the standard library @'catch'@+function.  There is also a 'throwI' function analogous to @'throwIO'@+in the standard library.  Because @'catch'@ only works in the IO+monad, 'catchI' and 'inumCatch' work by propagating synchronous+exceptions through the 'Iter' monad.  @'liftIO'@ transforms IO errors+into such synchronous exceptions.  Unfortunately, there is no way to+handle asynchronous exceptions such as those that arise in lazily+evaluated pure code (e.g., divide by zero) or those thrown by another+thread using @'throwTo'@.  Fortunately, for our @grep@ example, we+only need to catch IO errors.++Here is the @grep@ code.  We will analyze it below.++@+    grep :: String -> [FilePath] -> IO ()+    grep re files+        | null files = 'enumStdin' '|.' inumToLines '|$' inumGrep re '.|' linesOutI+        | otherwise  = foldr1 'cat' (map enumLines files) '|$' inumGrep re '.|' linesOutI+        where+          enumLines file = 'inumCatch' ('enumFile' file '|.' inumToLines) handler+          handler :: 'IOError'+                  -> 'IterR' () IO ('IterR' [S.ByteString] IO a)+                  -> 'Iter' () IO ('IterR' [S.ByteString] IO a)+          handler e result = do+            liftIO (hPutStrLn stderr $ show e)+            'resumeI' result+          linesOutI = do+            mline <- 'safeHeadI'+            case mline of+              Just line -> do liftIO $ S.putStrLn line+                              linesOutI+              Nothing -> return ()+@++There are two cases.  If the list of files to search is null, @grep@+simply reads from standard input, in which case there is only one+input stream and we do not care about resuming.  In the second case,+we use @'foldr1' 'cat'@ to concatenate a list of 'Onum's.  Each 'Onum'+is generated by the function @enumLines@, which fuses 'enumFile' to+our previously defined @inumToLines@, but also wraps the exception+handler function @handler@ around the enumerator using 'inumCatch'.++Note that unlike @catch@, 'inumCatch' expects an exception handler to+have /two/ arguments.  The first argument, @e@ in this example, is the+exception itself.  As with @catch@, the type of @e@ determines which+exceptions are caught, which is why we must either specify an explicit+type signature for @handler@ or somewhere specify @e@'s type+explicitly, for instance with:++>          ...+>            liftIO (hPutStrLn stderr $ show (e :: IOError))+>          ...++Note that 'IOError' doesn't expose a type constructor, but for+exception types that do, it often suffices to define the function with+the exception constructor, as:++>          handler e@(SomeException _) result = do ...++The second argument to @handler@, @result@, is the failed state of the+iteratee, which contains more information than just the exception.  In+the case of an 'Inum' failure, it contains the state of the 'Iter'+that the 'Inum' was feeding when it failed.  The type of 'result' is+'IterR'--which is the type returned by 'Iter's when they are fed+chunks of data.  'IterR' takes the same three type arguments as+'Iter'.  The function 'resumeI' extracts and returns an @'Iter'+[S.ByteString] IO a@ from this failed result.  Thus, the next+enumerator in a concatenated series can continue feeding it input.+If, instead of resuming, you want to re-throw the error, it suffices+to re-execute the failed result with @'reRunIter'@.  For instance,+suppose we want to continue executing @grep@ when a named file does+not exist, but if some other error happens, we want to re-throw the+exception to abort the whole program.  This could be achieved as+follows:++>          handler e result = do+>            if isDoesNotExistError e+>              then do liftIO (hPutStrLn stderr $ show e)+>                      resumeI result+>              else reRunIter result++Because printing an exception is so common, there is a function+'verboseResumeI' that prints exceptions before resuming (also+prefixing the program name).  Thus, we can simplify the above function+to:++>          handler e result = if isDoesNotExistError e+>                               then verboseResumeI result+>                               else reRunIter result++These last two @handler@ functions also do away with the need for an+explicit type signature, because the function @'isDoesNotExistError'@+has argument type 'IOError', constraining the type of @e@ to the type+of exceptions we want to catch.++-}++{- $Differences++The Iteratee approach was originally advocated by Oleg Kiselyov (see+talk slides at <http://okmij.org/ftp/Streams.html#iteratee>).  The+main implementation by Kiselyov and John Lato is simply called+/iteratee/ (<http://hackage.haskell.org/package/iteratee>).  Another+realization of the iteratee concepts is the /enumerator/ package+(<http://hackage.haskell.org/package/enumerator>).  IterIO is a+re-implementation of these concepts from scratch.  This section+discusses the differences between previous packages and iterIO, both+as a means for motivating iterIO's design and as a set of suggestions+for improving other iteratee implementations.++* /Base abstraction/++The iterIO package represents an iteratee as a pure function from a+chunk of pending input data to an iteratee result of type 'IterR':++@+  newtype 'Iter' t m a = 'Iter' { runIter :: 'Chunk' t -> 'IterR' t m a }+@++An 'IterR' can yield a result and residual input, or it can ask for+more input, or it can request to have an action executed in the+underlying monad, or it can signal failure.  The fact that all+iteratees are functions of input ensures that iteratees generally see+/all/ pending input.  Thus, iteratees can do things like measure the+length of buffered input to subtract it from the current file offset+and determine the effective position in a file.++`IterR`'s division of iteratee results into different outcomes such as+needing input or needing monadic actions allows the library to+distinguish between pure iteratees and those with potential side+effects.  The ability to know that a specific iteratee is a pure+function in many cases allows one to parse LL(*) grammars without+large amounts of input buffering for backtracking (see below).++In contrast, the iteratee package uses continuation passing style+(CPS), in which an iteratee is a function taking two continuation+functions--one to call when done, and a second to call when either+requesting more input or failing:++> -- From the iteratee package:+> newtype Iteratee s m a = Iteratee{ runIter :: forall r.+>        -- First the "onDone" function:+>           (a -> Stream s -> m r) ->+>        -- Next the "onCont" function:+>           ((Stream s -> Iteratee s m a) -> Maybe SomeException -> m r) ->+>           m r}++CPS has the advantage of exposing the bind operator of the underlying+monad, making 'lift' cheap and simple.  Moreover, splitting into two+continuations saves the first and most common one (i.e., \"onDone\")+from the overhead of checking whether an error condition or request+for more input has occurred.  See+<http://haskell.org/haskellwiki/Performance/Monads#Use__Continuation_Passing_Style>+for a good discussion of the advantages of CPS.++Because of CPS, iteratee should be capable of delivering the best+performance of the three iteratee packages.  A disadvantage of+iterIO's approach is that every invocation of 'lift' must be+propagated all the way up the call chain, where a small amount of+overhead is added for each enclosing 'catchI' or similar call.  While+iterIO can handle most successful 'IterR' outcomes and caught+exceptions locally without popping back up the call stack, there is+also potentially overhead from actually checking that the outcome was+successful at each bind site.  (GHC's inliner may be able to avoid the+check in some cases.)++However, iteratee lacks several features of iterIO; offering these+features would likely reduce the benefits of CPS and complicate code.+For instance, there is no way to execute a pure iteratee without+monadic actions (the benefit touted above and described below for+LL(*) parsing).  Moreover, iteratee's exception mechanism discards the+current location in the input stream, making it unsuitable for failed+parse alternatives.  IterIO provides a general control mechanism to+make arbitrary requests from enumerators (such as seek, tell,+getpeername, get SSL information, etc.); iteratee instead overloads+the exception mechanism for control purposes, which prevents control+operations from returning values.  Thus, while iteratee can implement+seek, it cannot, for instance, implement tell.++The enumerator package's approach is closer to iterIO's, but makes+every iteratee into a monadic action in the underlying monad @m@:++> -- From the enumerator package:+> newtype Iteratee a m b = Iteratee { runIteratee :: m (Step a m b) }++Here @Step@ is similar to iterIO's 'IterR' type, but the @m@ wrapper+disallows iterIO's LL(*) parsing tricks.  It also causes gratuitous+invocation of @m@'s bind function, which can be expensive when using+stacks of monad transformers.  Furthermore, enumerator discards the+input state on all errors, making it impossible to resume from+failures that leave the input in a known state (such as a parsing+lookahead failure).++* /Uniformity of abstraction/++IterIO's abstractions were refined over many iterations to become+minimal yet highly expressive and familiar to Unix shell users.  Thus,+we have 'Iter's, which are data sinks that consume input and produce a+result.  Then we have 'Inum's, which are also 'Iter's.  These two data+types and can combined through pipes (i.e., fusing) and concatenation,+both of which have direct analogues in the Unix @|@ (pipe) operator+and @cat@ command.++Basing everything around these few concepts makes the library easier+to learn and use.  For instance, because all 'Inum's are 'Iter's,+there is only one set of 'Iter' building blocks to learn.  'Inum'+implementations invoke the same 'Iter's that are used to build other+'Iter's.  Moreover, 'Inum's and 'Iter's use the same error handling+mechanism.  Finally, because 'Onum's are also 'Inum's, one set of+fusing and concatenation operators works for both.++By contrast, both the iteratee and enumerator packages use enumerator+types that are not iteratees.  Hence, constructing enumerators is+harder and requires a different error handing mechanism.  The packages+must introduce a third, hybrid \"Enumeratee\" type for inner pipeline+stages, and fusing Enumerators to Enumeratees is a different function+from fusing Enumeratees together.++Funneling everything through a small number of abstractions also+ensures that the right thing happens in corner cases.  In particular,+all enumerator application happens through the pipe operator.  Though+there are two pipe operators, a left associative one and a right+associative one, they internally use the same function:  @a '|.' b =+(a '.|') . b@.  Similarly, the pipe application operators ('|$' and+'.|$') are defined in terms of '.|'.++'.|' guarantees that its right-hand argument will receive an EOF when+the left hand argument terminates (whether normally or through an+exception).  This is crucial for managing resources such file+descriptors, and works no matter how convoluted the control structure+of your program.++Consider the following realistic scenario of a web server constructed+as an 'Inum' that translates from HTTP requests to HTTP responses.+(Such an 'Inum' is provided by the function 'inumHttpServer' in+"Data.IterIO.HTTP".)  The server's accept loop would resemble the+following:++@+   loop = do+     (sock, _) <- Net.accept $ listen_socket+     _ <- forkIO $ do+            (iter, enum) <- 'iterStream' (sock)+            enum '|$' 'inumHttpServer' ('ioHttpServer' handler) '.|' iter+     loop+@++This code depends on the fact that 'iterStream' closes @sock@ after+both the @iter@ has received an EOF and the @enum@ has returned.  One+level down, 'inumHttpServer' uses 'mkInumM' to construct an 'Inum',+and has code looking something like this:++@+     req <- 'httpReqI'                              -- parse HTTP request+     resp <- 'liftI' $ inumHttpBody .| handler req  -- invoke handler+     'irun' $ enumHttpResp resp Nothing             -- send response to client+@++The @handler@ gets run on the body of the message, and might decide to+process an HTTP POST request by saving an uploaded file to disk, for+instance with code like this:++@+     let saveFile _ field+           | ffName field == S8.pack \"file\" = do+                            h <- liftIO $ openBinaryFile \"upload\" WriteMode+                            'handleI' h ``finallyI`` liftIO (hClose h)+           | otherwise = return ()+     in foldForm req saveFile ()+@++@foldForm@ internally is invoking an 'Inum' that parses HTTP+multipart/form-data to pipe each field of the form to the @saveFile@+function.++Now suppose 'inumHttpBody' fails (most likely because it receives an+EOF before reading the number of bytes specified in the Content-Length+header).  Because 'inumHttpBody' is fused to @handler@, the failure+will cause @handler@ to receive an EOF, which will cause @foldForm@ to+fail, which will cause 'handleI' to receive an EOF and return, which+will ensure 'hClose' runs and the file handle @h@ is not leaked.++Once the EOFs have been processed, the exception will propagate+upwards making 'inumHttpServer' fail, which in turn will send an EOF+to @iter@.  Then the exception will cause @enum@ to fail, after which+@sock@ will be closed.  In summary, despite the complex structure of+the web server, because all the components are fused together with+pipe operators, corner cases like this just work with no need to worry+about leaked file descriptors.++* /Uniform error-handling and simplified monad transformers/++The iterIO library provides a traditional throw and catch exception+mechanism using its own functions 'throwI' and 'catchI', but keeping+the standard library exception hierarchy from "Control.Exception".+All of the support routines are carefully crafted to ensure that this+single exception mechanism is the only one you ever need, so that you+don't end up having to integrate different components with different+error strategies, a situation summarized amusingly in the following+blog post:+<http://www.randomhacks.net/articles/2007/03/10/haskell-8-ways-to-report-errors>.++A key to uniform error handling is ensuring that errors can be+propagated cleanly across different monads and transformers.  Thus,+for instance, the iterIO 'liftIO' function translates all uncaught IO+errors into 'Iter' errors.++More importantly, iterIO is designed to support the standard mtl monad+transformers while keeping 'Iter' as the outermost monadic type.  For+instance, if deep in the middle of some @'Iter' t 'IO'@ computation+you need a state transformer monad, you can invoke one with+'runStateTI', which is the iterIO equivalent of 'runStateT'.  As seen+by comparing their effective types, 'runStateTI' keeps the 'Iter'+monad on the outside, and thus can cleanly propagate failures out of+the 'StateT' subcomputation:++> runStateT  :: StateT s m a -> s -> m (a, s)+>+> runStateTI :: Iter t (StateT s m) a -> s -> Iter t m (a, s)++Similarly, there is a function @'liftI' :: (MonadTrans t) => Iter+s m a -> Iter s (t m) a@ that can be used to execute a computation in+which a level of monad transformer is stripped off the inner monadic+type.++An equally important feature is the ability to distinguish 'Iter'+failures from 'Inum' failures, given that the former are often more+serious than the latter.  As shown by the @grep@ example in the+tutorial above, when one in a series of concatenated 'Inum's fails,+you often want to keep going without losing the state of the 'Iter'.+The enumerator package does not appear to support this distinction.+The iteratee package might, but it is not clear how to implement the+iteratee equivalent of the @grep@ example above.++By contrast, iterIO's 'Inum' mechanism was designed to be intuitive.+If you wrap a pipeline of 'Inum's in an 'inumCatch' statement, then+you will catch exactly the errors thrown by those 'Inum's, not those+thrown by pipeline stages outside the scope of the 'inumCatch' call.++It is because of this unified error handling mechanism that examples+such as the HTTP server above can be guaranteed not to leak resources.++* /Parser combinators for LL(*) grammars/++IterIO's "Data.IterIO.Parse" module supports parsing of iteratee input+using combinators similar to those found in parsec.  However, parsec+supports only LL(1) grammars, and can lead to confusing failures--for+instance the parser @string \"foo\" \<|\> string \"for\"@ would fail+on input @\"for\"@.  IterIO, by contrast, supports full LL(*) parsing,+meaning a parser can look arbitrarily far ahead before failing.++LL(*) parsers are generally disfavored because of their potential to+consume arbitrarily large amounts of memory to remember input for+backtracking.  However, iterIO offers two mechanisms that mitigate the+problem.++First, because 'Iter's are constructed in such a way as to+differentiate requests for more input from execution of monadic+actions, it is possible to run multiple parsers in parallel.  Consider+a hypothetical parser such as the following, designed to recognize the+input format and parse either XML or JSON data:++@+  parser :: 'Iter' 'L.ByteString' m Value+  parser = ('string' \"\<!DOCTYPE\" >> parseXml)+           \<|\> ('char' \'{\' >> parseJson)+@++@\<|\>@ is an infix synonym for the iterIO function 'multiParse',+which attempts to run two parsers concurrently on input as it arrives.+Because 'string' and 'char' are both pure parser combinators with no+monadic side effects, it is possible to run them both concurrently+without fear that the second rule--if it fails--will nonetheless have+produced side effects.  In fact, at least one of the 'string' or the+'char' action will fail almost immediately, likely on the first chunk+of data.  After one of the two has signaled a parse error, there is no+longer any need to store input for backtracking.  Note this works even+if the subsequent functions @parseXml@ and @parseJson@ have monadic+side effects, because 'multiParse' doesn't need to invoke those+monadic actions to determine that one of the two parsers has failed.++A second way to avoid large amounts of storage for backtracking is to+use iterIO's '\/' operator, which is an infix synonym for 'ifNoParse'.+The formulation @iter '\/' no $ yes@ splits a parser into three+components.  @iter@ is executed with backtracking enabled.  If it+succeeds, then the saved data is discarded, @iter@'s result is fed to+the function @yes@, and any further failures will not cause input to+be rewound.  If, on the other hand, @iter@ fails, then input is+rewound and @no@ is executed.  The '\/' operator is very convenient+for long folds whose individual elements do not consume a lot of+input.  For example, to parse and sum a list of numbers (given a+parser @number@ that skips spaces then parses one number), you might+do something like this:++> parseAndSumIntegerList :: Iter String IO Int+> parseAndSumIntegerList = loop 0+>     where loop n = number \/ return n $ \n' -> loop (n + n')++Regardless of the length of the list of numbers being parsed,+@sumNumbers@ only ever needs to backtrack over the input consumed by a+single iteration of @number@, which is likely a small amount of extra+memory to keep around.++If you do want an LL(1) parser combinator library, iterIO supports+seamless integration with the attoparsec package.  The function 'atto'+in "Data.IterIO.Atto" turns an attoparsec @Parser@ into an 'Iter'+monad, treating an attoparsec failure as an 'Iter' exception that can+be handled in the usual way with 'ifParse' or 'multiParse', or just+caught with 'catchI'.  (Attoparsec has the additional advantage of+solving the annoying @string \"foo\" \<|\> string \"for\"@ issue by+special-casing @string@ to have more lookahead.)++Preliminary testing suggests that attoparsec can be about three times+faster than "Data.IterIO.Parse" on parse-intensive workloads.  The+limitation is that attoparsec parsers must be pure.  A good compromise+may be to use IterIO for coarse-grained parsing, and attoparsec for+more complex data structures.  For example, you might want to use+iterIO's parsing of HTTP multipart/form-data (so as to be able to pipe+files to disk in constant space), but for fields with JSON data, use+'atto' to pipe the contents to the excellent attoparsec-based aeson+package.++-}++{- $Acknowledgments++Daniel Giffin contributed numerous suggestions and improvements to+both the code and documentation.  Deian Stefan and David Terei helped+with testing and improving the package, as well as understanding+various relevant aspects of Haskell and GHC.  Mike Hamburg made the+key suggestion of defining 'Onum's as type-restricted 'Inum's.  The+author is grateful to John Lato for helping him understand much of the+important design rationale behind the original iteratee package.  This+work was funded by the DARPA Clean-Slate Design of Resilient,+Adaptive, Secure Hosts (CRASH) program, BAA-10-70.++-}++--  LocalWords:  IterIO iteratee monad mtl Iter combinators zlib gzip SSL Inum+--  LocalWords:  attoparsec parsers loopback monadic Iteratees ChunkData tIn kk+--  LocalWords:  MonadIO iteratees tOut transcoding Inum's mkInum mkInumM Onum+--  LocalWords:  transcode inumPure transcodes enum iterIO Haskell mempty lineI+--  LocalWords:  headFile FilePath enumFile Iter's stdoutI handleI catFile EOF+--  LocalWords:  ByteString enumfile MonadTrans liftIOexampleI liftIO putStrLn+--  LocalWords:  takeI wc lineCountI safeLineI ByteStrings inumToLines Onum's+--  LocalWords:  InumM throwEOFI inumGrep headI packedRe lengthI safeHeadI usr+--  LocalWords:  whileNullI grepCount catchI inumCatch throwI throwIO enumStdin+--  LocalWords:  linesOutI foldr enumLines IOError IterR hPutStrLn stderr mline+--  LocalWords:  resumeI isDoesNotExistError reRunIter verboseResumeI Oleg Lato+--  LocalWords:  Kiselyov iterIO's newtype runIter forall onDone onCont GHC's+--  LocalWords:  SomeException inliner iteratee's getpeername runIteratee iter+--  LocalWords:  lookahead Enumeratee Enumeratees inumHttpServer forkIO req GHC+--  LocalWords:  iterStream ioHttpServer httpReqI liftI inumHttpBody irun EOFs+--  LocalWords:  enumHttpResp saveFile ffName openBinaryFile WriteMode finallyI+--  LocalWords:  hClose foldForm multipart monads runStateTI runStateT StateT+--  LocalWords:  subcomputation enumeratee JSON DOCTYPE parseXml parseJson atto+--  LocalWords:  multiParse ifNoParse parseAndSumIntegerList sumNumbers ifParse+--  LocalWords:  combinator aeson Giffin Deian Terei DARPA

@@ -0,0 +1,52 @@+{-# 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++import Data.IterIO++-- | Class of types whose 'Iter's can be converted to strict+-- 'S.ByteString's.  Basically just strict 'S.ByteString's and lazy+-- 'L.ByteString's.  This class mostly exists so that the 'atto'+-- function can work with either type of ByteString.+class (ChunkData t) => IterStrictByteString t where+    fromIterStrictByteString :: (Monad m) => Iter S.ByteString m a -> Iter t m a++instance IterStrictByteString S.ByteString where+    {-# INLINE fromIterStrictByteString #-}+    fromIterStrictByteString = id++instance IterStrictByteString L.ByteString where+    {-# INLINE fromIterStrictByteString #-}+    fromIterStrictByteString = (inumLtoS .|)++-- | Run an attoparsec parser in an 'Iter' monad.  Throws an+-- 'IterFail' exception with constructor 'IterParseErr' if the parse+-- fails.  (This exception can be handled with 'multiParse' and+-- 'ifParse'.)+atto :: (IterStrictByteString t, Monad m) =>+        A.Parser a -> Iter t m a+atto parser = fromIterStrictByteString $+              data0I >>= A.parseWith data0I parser >>= check+    where check (A.Done t a)   = ungetI t >> return a+          check (A.Fail t _ e) = ungetI t >> throwParseI e+          check _              = error $ "atto: Partial"++-- | Try running an attoparsec parser.  Returns @'Right' a@ if the+-- parser succeeds with result @a@.  Returns @'Left' err@ where @err@+-- is an error message otherwise.  Note that the input stream will be+-- in an indeterminate state should the parser fail.  (If you need to+-- keep parsing input from some known state, it may be better to use+-- 'atto' in conjunction with 'multiParse'.)+tryAtto :: (IterStrictByteString t, Monad m) =>+           A.Parser a -> Iter t m (Either String a)+tryAtto parser = either check Right `fmap` tryFI (atto parser)+    where check (IterParseErr e) = Left e+          check _                = error "tryAtto"

@@ -0,0 +1,223 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE FlexibleInstances #-}++-- | This module contains miscellaneous functions plus a few pieces of+-- functionality that are missing from the standard Haskell libraries.+module Data.IterIO.Extra+    ( -- * Miscellaneous+      iterLoop+    , inumSplit+    -- , fixIterPure+      -- * Functionality missing from system libraries+    , SendRecvString(..)+    , hShutdown+    -- * Debugging functions+    , traceInput, traceI+    ) where++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans+import Data.ByteString.Internal (inlinePerformIO)+import Data.Monoid+import Debug.Trace+import Foreign.C+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import Network.Socket+import Network.Socket.ByteString as S+import Network.Socket.ByteString.Lazy as L+import System.IO++import Data.IterIO.Iter+import Data.IterIO.Inum++import Data.Typeable+import System.IO.Error+import GHC.IO.FD (FD(..))+import GHC.IO.Handle.Types (Handle__(..))+import GHC.IO.Handle.Internals (wantWritableHandle)++foreign import ccall unsafe "sys/socket.h shutdown"+  c_shutdown :: CInt -> CInt -> IO CInt++-- | Create a loopback @('Iter', 'Onum')@ pair.  The iteratee and+-- enumerator can be used in different threads.  Any data fed into the+-- 'Iter' will in turn be fed by the 'Onum' into whatever 'Iter' it+-- is given.  This is useful for testing a protocol implementation+-- against itself.+iterLoop :: (MonadIO m, ChunkData t, Show t) =>+            m (Iter t m (), Onum t m a)+iterLoop = do+  -- The loopback is implemented with an MVar (MVar Chunk).  The+  -- enumerator waits on the inner MVar, while the iteratee uses the outer +  -- MVar to avoid races when appending to the stored chunk.+  mv <- liftIO $ newEmptyMVar >>= newMVar+  return (iter mv, enum mv)+    where+      iter mv = do+             c@(Chunk _ eof) <- chunkI+             liftIO $ withMVar mv $ \p ->+                 do mp <- tryTakeMVar p+                    putMVar p $ case mp of+                                  Nothing -> c+                                  Just c' -> mappend c' c+             if eof then return () else iter mv++      -- Note the ifeed mempty, which is there in case the enum feeds+      -- an iter that starts with a liftIO or something, and the other+      -- half of the loopback interface waits for the result of that+      -- liftIO to start producing data.+      enum mv = mkInumM (ifeed mempty >> loop)+          where loop = do p <- liftIO $ readMVar mv+                          Chunk t eof <- liftIO $ takeMVar p+                          done <- ifeed t+                          when (not $ eof || done) loop+                  +-- | Returns an 'Iter' that always returns itself until a result is+-- produced.  You can fuse @inumSplit@ to an 'Iter' to produce an+-- 'Iter' that can safely be fed (e.g., with 'enumPure') from multiple+-- threads.+inumSplit :: (MonadIO m, ChunkData t) => Inum t t m a+inumSplit iter1 = do+  mv <- liftIO $ newMVar $ IterF iter1+  iter mv+    where+      iter mv = do+        (Chunk t eof) <- chunkI+        rold <- liftIO $ takeMVar mv+        rnew <- runIterMC (passCtl pullupResid) (reRunIter rold) $ chunk t+        liftIO $ putMVar mv rnew+        case rnew of+          IterF _ | not eof -> iter mv+          _                 -> return rnew++{- fixIterPure allows MonadFix instances, which support+   out-of-order name bindings in a "rec" block, provided your file+   has {-# LANGUAGE RecursiveDo #-} at the top.  A contrived example+   would be:++fixtest :: IO Int+fixtest = enumPure [10] `cat` enumPure [1] |$ fixee+    where+      fixee :: Iter [Int] IO Int+      fixee = rec+        liftIO $ putStrLn "test #1"+        c <- return $ a + b+        liftIO $ putStrLn "test #2"+        a <- headI+        liftIO $ putStrLn "test #3"+        b <- headI+        liftIO $ putStrLn "test #4"+        return c++-- A very convoluted way of computing factorial+fixtest2 :: Int -> IO Int+fixtest2 i = do+  f <- enumPure [2] `cat` enumPure [1] |$ mfix fact+  run $ f i+    where+      fact :: (Int -> Iter [Int] IO Int)+           -> Iter [Int] IO (Int -> Iter [Int] IO Int)+      fact f = do+               ignore <- headI+               liftIO $ putStrLn $ "ignoring " ++ show ignore+               base <- headI+               liftIO $ putStrLn $ "base is " ++ show base+               return $ \n -> if n <=  0+                              then return base+                              else liftM (n *) (f $ n - 1)++-- | This is a fixed point combinator for iteratees over monads that+-- have no side effects.  If you wish to use @rec@ with such a monad,+-- you can define an instance of 'MonadFix' in which+-- @'mfix' = fixIterPure@.  However, be warned that this /only/ works+-- when computations in the monad have no side effects, as+-- @fixIterPure@ will repeatedly re-invoke the function passsed in+-- when more input is required (thereby also repeating side-effects).+-- For cases in which the monad may have side effects, if the monad is+-- in the 'MonadIO' class then there is already an 'mfix' instance+-- defined using 'fixMonadIO'.+fixIterPure :: (ChunkData t, MonadFix m) =>+               (a -> Iter t m a) -> Iter t m a+fixIterPure f = Iter $ \c ->+  let ff ~(Done a _)  = check $ runIter (f a) c+      -- Warning: IterF case re-runs function, repeating side effects+      check (IterF _) = return $ IterF $ Iter $ \c' ->+                        runIter (fixIterPure f) (mappend c c')+      check (IterM m) = m >>= check+      check r         = return r+  in IterM $ mfix ff+-}+++--+-- Some utility functions for things that are made hard by the Haskell+-- libraries+--++-- | @SendRecvString@ is the class of string-like objects that can be+-- used with datagram sockets.+class (Show t) => SendRecvString t where+    genRecv     :: Socket -> Int -> IO t+    genSend     :: Socket -> t -> IO ()+    genRecvFrom :: Socket -> Int -> IO (t, SockAddr)+    genSendTo   :: Socket -> t -> SockAddr -> IO ()++instance SendRecvString [Char] where+    genRecv s len        = liftM S8.unpack $ S.recv s len+    genSend s str        = S.sendAll s (S8.pack str)+    genRecvFrom s len    = do (str, a) <- S.recvFrom s len+                              return (S8.unpack str, a)+    genSendTo s str dest = S.sendAllTo s (S8.pack str) dest++instance SendRecvString S.ByteString where+    genRecv s len        = S.recv s len+    genSend s str        = S.sendAll s str+    genRecvFrom s len    = S.recvFrom s len+    genSendTo s str dest = S.sendAllTo s str dest++instance SendRecvString L.ByteString where+    genRecv s len        = do str <- S.recv s len+                              return $ L.fromChunks [str]+    genSend s str        = L.sendAll s str+    genRecvFrom s len    = do (str, a) <- S.recvFrom s len+                              return (L.fromChunks [str], a)+    genSendTo s str dest = S.sendManyTo s (L.toChunks str) dest++-- | Flushes a file handle and calls the /shutdown/ system call so as+-- to write an EOF to a socket while still being able to read from it.+-- This is very important when the same file handle is being used to+-- to read data in an 'Onum' and to write data in an 'Iter'.  Proper+-- protocol functioning may require the 'Iter' to send an EOF (e.g., a+-- TCP FIN segment), but the 'Onum' may still be reading from the+-- socket in a different thread.+hShutdown                            :: Handle -> CInt -> IO Int+hShutdown h how = do+  hFlush h+  wantWritableHandle "hShutdown" h $ \Handle__ {haDevice = dev} ->+      case cast dev of+        Just (FD {fdFD = fd}) -> liftM fromEnum $ c_shutdown fd how+        Nothing -> ioError (ioeSetErrorString+                            (mkIOError illegalOperationErrorType+                             "hShutdown" (Just h) Nothing) +                            "handle is not a file descriptor")+  +--+-- Debugging+--++-- | For debugging, print a tag along with the current residual input.+-- Not referentially transparent.+traceInput :: (ChunkData t, Monad m) => String -> Iter t m ()+traceInput tag = Iter $ \c -> trace (tag ++ ": " ++ show c) $ Done () c++-- | For debugging.  Print the current thread ID and a message.  Not+-- referentially transparent.+traceI :: (ChunkData t, Monad m) => String -> Iter t m ()+traceI msg = Iter $ \c -> inlinePerformIO $ do+               tid <- myThreadId+               putTraceMsg $ show tid ++ ": " ++ msg+               return $ Done () c

@@ -0,0 +1,1333 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module Data.IterIO.Http (-- * HTTP Request support+                         HttpReq(..), reqNormalPath+                        , httpReqI, inumHttpBody+                        , inumToChunks, inumFromChunks+                        , http_fmt_time, dateI+                        , FormField(..), foldForm+                        -- , urlencodedFormI, multipartI, inumMultipart+                        -- , foldUrlencoded, foldMultipart, foldQuery+                        -- * HTTP Response support+                        , HttpStatus(..)+                        , stat100, stat200, stat301, stat302, stat303, stat304+                        , stat400, stat401, stat403, stat404, stat405+                        , stat500, stat501+                        , HttpResp(..), defaultHttpResp+                        , mkHttpHead, mkHtmlResp, mkContentLenResp, mkOnumResp+                        , resp301, resp303, resp403, resp404, resp405, resp500+                        , enumHttpResp+                        -- * HTTP connection handling+                        , HttpRequestHandler+                        , HttpServerConf(..), nullHttpServer, ioHttpServer+                        , inumHttpServer+                        -- -- * For debugging+                        -- , postReq, encReq, mptest, mptest'+                        -- , formTestMultipart, formTestUrlencoded+                        ) where++import Control.Exception (SomeException(..))+import Control.Monad+import Control.Monad.Identity+import Control.Monad.Trans+import Data.Array.Unboxed+import Data.Bits+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import Data.ByteString.Internal (w2c, c2w)+-- import Data.Bits+import Data.Char+import Data.Int+import Data.List+import Data.Time+import Data.Typeable+import Data.Word+import System.Locale (defaultTimeLocale)+import System.IO+import Text.Printf++import Data.IterIO+import Data.IterIO.Parse+import Data.IterIO.Search++-- import System.IO++type L = L8.ByteString+type S = S.ByteString++strictify :: L -> S+strictify = S.concat . L.toChunks++--+-- Basic pieces+--++-- | Secton 19.3 of RFC2616: "The line terminator for message-header+-- fields is the sequence CRLF.  However, we recommend that+-- applications, when parsing such headers, recognize a single LF as a+-- line terminator and ignore the leading CR."+crlf :: (Monad m) => Iter L m Word8+crlf = char '\r' *> char '\n' <|> char '\n'++-- | Spaces and tabs+spaces :: (Monad m) => Iter L m ()+spaces = skipWhile1I (\c -> c == eord ' ' || c == eord '\t')+         <?> "spaces"++-- | Linear whitespace, defined as:+--+-- >  LWS            = [CRLF] 1*( SP | HT )+--+-- Parses as a single space+lws :: (Monad m) => Iter L m L+lws = optionalI crlf >> L8.singleton ' ' <$ spaces <?> "linear white space"++-- | @olws = 'optionalI' 'lws'@+olws :: (Monad m) => Iter L m ()+olws = optionalI lws++-- | non-control characters+noctl :: (Monad m) => Iter L m L+noctl = while1I (\c -> c >= 0x20 && c < 0x7f) <?> "non-control characters"++-- | TEXT = 1*(any OCTET except CTLs | LWS)+text :: (Monad m) => Iter L m L+text = concat1I (noctl <|> lws) <?> "text (Data.IterIO.Http)"++-- | 'text' excluding some list of except characters.+text_except :: (Monad m) => String -> Iter L m L+text_except except = concat1I (while1I ok <|> lws)+    where+      except' = fmap c2w except+      ok c = c >= 0x20 && c < 0x7f && not (c `elem` except')++-- | Parse one hex digit and return its value from 0-15.+hex :: (Monad m) => Iter L m Int+hex = headI >>= digit <?> "hex digit"+    where+      digit c | c > 127   = expectedI (show $ w2c c) "hex digit"+              | otherwise = case hexTab ! c of+                              -1 -> expectedI (show $ w2c c) "hex digit"+                              n  -> return $ fromIntegral n+      hexTab :: UArray Word8 Int8+      hexTab = listArray (0,127) $ fmap digitval ['\0'..'\177']+      digitval c | isHexDigit c = toEnum $ digitToInt c+                 | otherwise    = -1++-- | Parse a raw hexadecimal number (no \"0x...\" prefix).+hexInt :: (Monad m) => Iter L m Int+hexInt = foldM1I digit 0 hex+    where+      maxok = maxBound `shiftR` 4+      digit n d | n > maxok = throwParseI "hex integer too large"+                | otherwise = return $ (n `shiftL` 4) .|. d++-- | 1*\<any CHAR except CTLs or separators\>+token :: (Monad m) => Iter L m S+token = strictify <$> token'++-- | Lazy 'L.ByteString' version of 'token'.+token' :: (Monad m) => Iter L m L+token' = while1I (\c -> c < 127 && tokenTab ! c) <?> "token"+    where+      tokenTab :: UArray Word8 Bool+      tokenTab = listArray (0,127) $ fmap isTokenChar [0..127]+      isTokenChar c = c > 0x20 && c < 0x7f && not (elem (chr c) separators)+      separators = "()<>@,;:\\\"/[]?={} \t\177"++-- | Percent-decode input for as long as the non percent-escaped+-- characters match some predicate.+percent_decode :: (Monad m) => (Word8 -> Bool) -> Iter L m L+percent_decode test = foldrI L.cons' L.empty getc+    where+      getc = do+        c <- headI+        case c of+          _ | c == eord '%' -> getval+          _ | test c        -> return c+          _                 -> expectedI (show c) "percent_decode predicate"+      getval = do hi <- hex; lo <- hex; return $ toEnum $ 16 * hi + lo++-- | Parse a backslash-escaped character.+quoted_pair :: (Monad m) => Iter L m L+quoted_pair = char '\\' <:> headI <:> nil++-- | 'text' and 'quoted_pair's surrounded by double quotes.+quoted_string :: (Monad m) => Iter L m S+quoted_string = do char '"'+                   ret <- concatI (text_except "\"" <|> quoted_pair)+                   char '"'+                   return $ strictify ret++{-+-- | 'text' and 'quoted_pair's surrounded by parentheses.+comment :: (Monad m) => Iter L m L+comment = char '('+          <:> concatI (text_except "()" <|> quoted_pair <|> comment)+          <++> string ")"+          <?> "comment"++-- | Parses q=N where 0.000 <= N <= 1.000, and returns the result+-- multiplied by 1000 as an integer (i.e., 1.0 returns 1000).+qvalue :: (Monad m) => Iter L m Int+qvalue = do char 'q'; olws; char '='; olws; frac <|> one+    where+      frac = do char '0'+                char '.' \/ return 0 $ \_ ->+                    whileMinMaxI 0 3 (isDigit . w2c) \/ return 0 $ readI+      one = do char '1'+               optionalI $ do char '.'+                             optionalI $ whileMinMaxI 0 3 (== eord '0')+               return 1000+-}++parameter :: (Monad m) => Iter L m (S, S)+parameter = do+  olws+  k <- token+  olws; char '='; olws+  v <- token <|> quoted_string+  return (k, v)++--+-- Date/time+--++-- | Formats a time in the format specified by RFC 2616.+http_fmt_time :: UTCTime -> String+http_fmt_time = formatTime defaultTimeLocale "%a, %_d %b %Y %H:%M:%S GMT"++dowmap :: Map L Int+dowmap = Map.fromList $ flip zip ([0..6] ++ [0..6]) $+         map L8.pack ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"+                     , "Sunday", "Monday", "Tuesday", "Wednesday"+                     , "Thursday", "Friday", "Saturday", "Sunday"]++weekdayI :: (Monad m) => Iter L.ByteString m Int+weekdayI = mapI dowmap <?> "Day of Week"++monmap :: Map L Int+monmap = Map.fromList $ flip zip [1..12] $+         map L8.pack ["Jan", "Feb", "Mar", "Apr", "May", "Jun"+                     , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]++monthI :: (Monad m) => Iter L.ByteString m Int+monthI = mapI monmap <?> "Month"++timeI :: (Monad m) => Iter L.ByteString m TimeOfDay+timeI = do+  hours <- whileMinMaxI 2 2 (isDigit . w2c) >>= readI <?> "Hours"+  char ':'+  minutes <- whileMinMaxI 2 2 (isDigit . w2c) >>= readI <?> "Minutes"+  char ':'+  seconds <- whileMinMaxI 2 2 (isDigit . w2c) >>= readI <?> "Seconds"+  when (hours >= 24 || minutes >= 60 || seconds > 62) $ -- 2 leap seconds+       throwParseI "timeI: Invalid hours/minutes/seconds"+  return $ TimeOfDay hours minutes (fromIntegral (seconds :: Int))++rfc822_time :: (Monad m) => Iter L m UTCTime+rfc822_time = do+  weekdayI+  char ','+  spaces+  mday <- whileMinMaxI 1 2 (isDigit . w2c) >>= readI <?> "Day of Month"+  spaces+  month <- monthI+  spaces+  year <- whileMinMaxI 4 5 (isDigit . w2c) >>= readI <?> "Year"+  spaces+  tod <- timeI+  spaces+  string "GMT"+  return $ localTimeToUTC utc LocalTime {+                localDay = fromGregorian year month mday+              , localTimeOfDay = tod+              }++rfc850_time :: (Monad m) => Iter L m UTCTime+rfc850_time = do+  weekdayI+  char ','+  spaces+  mday <- whileMinMaxI 2 2 (isDigit . w2c) >>= readI <?> "Day of Month"+  char '-'+  month <- monthI+  char '-'+  year <- do y2 <- whileMinMaxI 2 2 (isDigit . w2c) >>= readI <?> "Year"+             return $ if y2 < 70 then y2 + 2000 else y2 + 1900+  spaces+  tod <- timeI+  spaces+  string "GMT"+  return $ localTimeToUTC utc LocalTime {+                localDay = fromGregorian year month mday+              , localTimeOfDay = tod+              }++asctime_time :: (Monad m) => Iter L m UTCTime+asctime_time = do+  weekdayI+  spaces+  month <- monthI+  spaces+  mday <- whileMinMaxI 1 2 (isDigit . w2c) >>= readI <?> "Day of Month"+  spaces+  tod <- timeI+  spaces+  year <- whileMinMaxI 4 5 (isDigit . w2c) >>= readI <?> "Year"+  return $ localTimeToUTC utc LocalTime {+                localDay = fromGregorian year month mday+              , localTimeOfDay = tod+              }++-- | Parses a Date/Time string in any one of the three formats+-- specified by RFC 2616.+dateI :: (Monad m) => Iter L.ByteString m UTCTime+dateI = rfc822_time <|> rfc850_time <|> asctime_time <?> "HTTP date/time"++--+-- URI parsing (RFC 3986)+--++-- | RFC3986 syntax classes unreserved characters+rfc3986_unreserved :: Word8+rfc3986_unreserved = 0x1++rfc3986_gen_delims :: Word8+rfc3986_gen_delims = 0x2++rfc3986_sub_delims :: Word8+rfc3986_sub_delims = 0x4++rfc3986_schemechars :: Word8+rfc3986_schemechars = 0x8++rfc3986_addrchars :: Word8+rfc3986_addrchars = 0x10++rfc3986_pcharslash :: Word8+rfc3986_pcharslash = 0x20++rfc3986_syntax :: UArray Word8 Word8+rfc3986_syntax = listArray (0, 255) $ fmap bits ['\0'..'\377']+    where+      bits c = foldl' (.|.) 0 [+                 if isAlphaNum c || c `elem` "-._~"+                 then rfc3986_unreserved else 0+               , if c `elem` ":/?#[]@" then rfc3986_gen_delims else 0+               , if c `elem` "!$&'()*+,;=" then rfc3986_sub_delims else 0+               , if isAlphaNum c || c `elem` "+-."+                 then rfc3986_schemechars else 0+               , if isAlphaNum c || c `elem` "-._~:!$&'()*+,;="+                 then rfc3986_addrchars else 0+               , if isAlphaNum c || c `elem` "-._~!$&'()*+,;=:@/"+                 then rfc3986_pcharslash else 0+               ]++rfc3986_test :: Word8 -> Word8 -> Bool+rfc3986_test mask c = rfc3986_syntax ! c .&. mask /= 0++{-+isUnreserved :: Word8 -> Bool+isUnreserved c = rfc3986_syntax ! c .&. rfc3986_unreserved /= 0+-}++hostI :: (Monad m) => Iter L m (S, Maybe Int)+hostI = (,) <$> host <*> (Just <$> port <|> return Nothing) <?> "host"+    where+      host = S8.map toLower <$> strictify <$>+             (bracketed <|> percent_decode regnamechar)+      port = do _ <- char ':'; whileI (isDigit . w2c) >>= readI+      regnamechar c = (rfc3986_syntax ! c+                       .&. (rfc3986_unreserved .|. rfc3986_sub_delims)) /= 0+      addrchar c = 0 /= rfc3986_syntax ! c .&. rfc3986_addrchars+      bracketed = char '[' <:> percent_decode addrchar <++> char ']' <:> nil++pathI :: (Monad m) => Iter L m (S, S)+pathI = dopath <?> "path"+    where+      dopath = do+        path <- strictify <$>+                (ensureI (== eord '/')+                 *> percent_decode (rfc3986_test rfc3986_pcharslash))+                <|> return (S8.pack "/")+        query <- char '?' *> (strictify <$> whileI qpcharslash) <|> nil+        return (path, query)+      qpcharslash c = rfc3986_test rfc3986_pcharslash c || c == eord '?'+ +-- | Returns (scheme, host, path, query)+absUri :: (Monad m) => Iter L m (S, S, Maybe Int, S, S)+absUri = do+  scheme <- strictify <$> satisfy (isAlpha . w2c)+            <:> while1I (rfc3986_test rfc3986_schemechars)+  string "://"+  optionalI $ userinfo >> string "@"+  authority <- hostI+  (path, query) <- pathI+  return (scheme, fst authority, snd authority, path, query)+    where+      userinfo = percent_decode $ \c ->+                 rfc3986_test (rfc3986_unreserved .|. rfc3986_sub_delims) c+                 || c == eord ':'+  +-- | Returns (scheme, host, path, query).+uri :: (Monad m) => Iter L m (S, S, Maybe Int, S, S)+uri = absUri+      <|> path+      <|> char '*' *> return (S.empty, S.empty, Nothing, S8.pack "*", S.empty)+      <?> "URI"+    where+      path = do (p, q) <- ensureI (== eord '/') *> pathI+                return (S.empty, S.empty, Nothing, p, q)++-- | Turn a path into a list of components+path2list :: S -> [S]+path2list path = runIdentity $ inumPure path |$ (slash [] <?> "absolute path")+    where+      slash acc = while1I (eord '/' ==) \/ eofI *> return (reverse acc) $+                  const $ comp acc+      comp acc  = while1I (eord '/' /=) \/ return (reverse acc) $ \n ->+                     case () of+                       () | n == S8.pack "." -> slash acc+                       () | n == S8.pack ".." ->+                              if null acc then slash [] else slash $ tail acc+                       () -> slash $ n:acc++--+-- HTTP request and header parsing+--++-- | Data structure representing an HTTP request message.+data HttpReq = HttpReq {+      reqMethod :: !S.ByteString+    -- ^ Method (e.g., GET, POST, ...).+    , reqPath :: !S.ByteString+    -- ^ Raw path from the URL (not needed if you use @reqPathList@+    -- and @reqPathParams@).+    , reqPathLst :: ![S.ByteString]+    -- ^ URL request path, broken into a list of directory components,+    -- and normalized to remove @\".\"@ and process @\"..\"@.+    , reqPathParams :: ![S.ByteString]+    -- ^ Used by 'routeVar' to save pathname components that are+    -- variables (used as a stack, so the last variable saved is the+    -- first one in the list).+    , reqPathCtx :: ![S.ByteString]+    -- ^ Stores pathname components that have been stripped off of+    -- @reqPathLst@ during routing.+    , reqQuery :: !S.ByteString+    -- ^ The portion of the URL after the @?@ character (if any).+    , reqHost :: !S.ByteString+    -- ^ Lower-case host header (or the host from the request line, if+    -- the request is for an absolute URI).+    , reqPort :: !(Maybe Int)+    -- ^ Port number if supplied in Host header.+    , reqVers :: !(Int, Int)+    -- ^ HTTP version major and minor number from the request line.+    , reqHeaders :: ![(S.ByteString, S.ByteString)]+    -- ^ List of all header field names and values in the HTTP+    -- request.  Field names are converted to lowercase to allow+    -- easier searching.+    , reqCookies :: ![(S.ByteString, S.ByteString)]+    -- ^ List of Cookies supplied in the request.+    , reqContentType :: !(Maybe (S.ByteString, [(S.ByteString,S.ByteString)]))+    -- ^ Parsed version of the Content-Type header, if any.  The first+    -- 'S.ByteString' is the actual content type.  Following this is a+    -- list of parameter names and values.  The most useful parameter+    -- is @\"boundary\"@, used with the @multipart/form-data@ content+    -- type.+    , reqContentLength :: !(Maybe Int)+    -- ^ Value of the content-Length header, if any.+    , reqTransferEncoding :: ![S.ByteString]+    -- ^ A list of the encodings in the Transfer-Encoding header.+    , reqIfModifiedSince :: !(Maybe UTCTime)+    } deriving (Typeable, Show)++defaultHttpReq :: HttpReq+defaultHttpReq = HttpReq { reqMethod = S.empty+                         , reqPath = S.empty+                         , reqPathLst = []+                         , reqPathParams = []+                         , reqPathCtx = []+                         , reqQuery = S.empty+                         , reqHost = S.empty+                         , reqPort = Nothing+                         , reqVers = (0, 0)+                         , reqHeaders = []+                         , reqCookies = []+                         , reqContentType = Nothing+                         , reqContentLength = Nothing+                         , reqTransferEncoding = []+                         , reqIfModifiedSince = Nothing+                         }++-- | Returns a normalized version of the full requested path+-- (including all context in 'reqCtx') in the URL (e.g., where @\".\"@+-- 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 rq =+    S.intercalate slash $ S.empty : reqPathCtx rq ++ reqPathLst rq+    where slash = S8.singleton '/'++hTTPvers :: (Monad m) => Iter L m (Int, Int)+hTTPvers = do+  string "HTTP/"+  major <- whileI (isDigit . w2c) >>= readI+  char '.'+  minor <- whileI (isDigit . w2c) >>= readI+  return (major, minor)++-- | 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 = do+  method <- strictify <$> while1I (isUpper . w2c)+  spaces+  (_, host, mport, path, query) <- uri+  spaces+  (major, minor) <- hTTPvers+  optionalI spaces+  skipI crlf+  return defaultHttpReq {+                 reqMethod = method+               , reqPath = path+               , reqPathLst = path2list path+               , reqQuery = query+               , reqHost = host+               , reqPort = mport+               , reqVers = (major, minor)+               }++request_headers :: (Monad m) => Map S (HttpReq -> Iter L m HttpReq)+request_headers = Map.fromList $+                  map (\(a, b) -> (S8.map toLower $ S8.pack a, b)) $+    [+      ("Host", host_hdr)+    , ("Cookie", cookie_hdr)+    , ("Content-Type", content_type_hdr)+    , ("Content-Length", content_length_hdr)+    , ("Transfer-Encoding", transfer_encoding_hdr)+    , ("If-Modified-Since", if_modified_since_hdr)+    ]++host_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+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 req = ifParse cookiesI setCookies ignore+  where+    cookiesI = sepBy1 parameter sep <* eofI+    sep = do olws; char ';' <|> char ','+    setCookies cookies = return $ req { reqCookies = cookies }+    ignore = nullI >> return req++content_type_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+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 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 req = do+  tclist <- many tc+  return req { reqTransferEncoding = tclist }+  where+    tc = do+      olws+      coding <- S8.map toLower <$> token+      skipMany $ olws >> char ';' >> parameter+      return coding++if_modified_since_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+if_modified_since_hdr req = do+  modtime <- dateI+  return req { reqIfModifiedSince = Just modtime }++hdr_field_val :: (Monad m) => Iter L m (S, S)+hdr_field_val = do+  field <- S8.map toLower <$> token+  char ':'+  olws+  val <- strictify <$> text+  crlf+  return (field, val)++any_hdr :: (Monad m) => HttpReq -> Iter L m HttpReq+any_hdr req = do+  (field, val) <- hdr_field_val+  let req' = req { reqHeaders = (field, val) : reqHeaders req }+  case Map.lookup field request_headers of+    Nothing -> return req'+    Just f  -> do+      r <- inumPure (L.fromChunks [val]) .|$+               (f req' <* (optionalI spaces >> eofI)+                      <?> (S8.unpack field ++ " header"))+      return r++-- | Parse an HTTP header, returning an 'HttpReq' data structure.+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+  -- expected. In other words, if the server is reading the protocol+  -- stream at the beginning of a message and receives a CRLF first,+  -- it should ignore the CRLF."+  skipMany crlf+  (request_line >>= next_hdr) <* crlf+    where next_hdr req = seq req $ any_hdr req \/ return req $ next_hdr+++--+-- Chunk encoding and decoding (RFC 2616)+--++-- | An HTTP Chunk encoder (as specified by RFC 2616).+inumToChunks :: (Monad m) => Inum L.ByteString L.ByteString m a+inumToChunks = mkInumM loop+    where+      loop = do+        Chunk s eof <- chunkI+        let len       = L8.length s+            chunksize = L8.pack $ printf "%x\r\n" len+            trailer   = if eof && len > 0+                        then L8.pack "\r\n0\r\n\r\n"+                        else L8.pack "\r\n"+        ifeed $ L8.concat [chunksize, s, trailer]+        unless eof loop++-- | An HTTP Chunk decoder (as specified by RFC 2616).+inumFromChunks :: (Monad m) => Inum L.ByteString L.ByteString m a+inumFromChunks = mkInumM $ getchunk+    where+      osp = skipWhileI $ \c -> c == eord ' ' || c == eord '\t'+      chunk_ext_val = do char '='; osp; token <|> quoted_string; osp+      chunk_ext = do char ';'; osp; token; osp; optionalI chunk_ext_val+      getchunk = do+        size <- hexInt <* (osp >> skipMany chunk_ext >> crlf)+        if size > 0 then ipipe (inumTakeExact size) >> getchunk+                    else do+                      skipMany (noctl >> crlf)+                      skipI crlf++-- | This 'Inum' reads to the end of an HTTP message body (and not+-- 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 req =+    case reqTransferEncoding req of+      lst | null lst || lst == [S8.pack "identity"] ->+              if hasclen then inumTakeExact (fromJust $ reqContentLength req)+                         else inumNull -- No message body present+      lst | lst == [S8.pack "chunked"] -> inumFromChunks+      lst -> inumFromChunks |. tcfold (reverse lst)+    where+      hasclen = isJust $ reqContentLength req+      tcfold [] = inumNop+      tcfold (h:t) +          | h == S8.pack "identity" = tcfold t+          | h == S8.pack "chunked"  = tcfold t -- Has to be first one+          --- | h == S8.pack "gzip"     = inumGunzip |. tcfold t+          | otherwise = mkInum $+                        fail $ "unknown Transfer-Coding " ++ chunkShow h++{-+-- | This 'Inum' reads to the end of an HTTP message body (and not+-- beyond) and decodes the Transfer-Encoding.  It handles straight+-- content of a size specified by the Content-Length header,+-- chunk-encoded content, and content that has been gzipped then+-- chunk-encoded.+inumHttpBodyZ :: (MonadIO m) => HttpReq -> Inum L.ByteString L.ByteString m a+inumHttpBodyZ req =+    case reqTransferEncoding req of+      lst | null lst || lst == [S8.pack "identity"] ->+              if hasclen then inumTakeExact (fromJust $ reqContentLength req)+                         else return -- No message body present+      lst | lst == [S8.pack "chunked"] -> inumFromChunks+      lst -> inumFromChunks |. tcfold (reverse lst)+    where+      hasclen = isJust $ reqContentLength req+      tcfold [] = inumNop+      tcfold (h:t) +          | h == S8.pack "identity" = tcfold t+          | h == S8.pack "chunked"  = tcfold t -- Has to be first one+          | h == S8.pack "gzip"     = inumGunzip |. tcfold t+          | otherwise = mkInum $ fail $ "unknown Transfer-Coding "+                        ++ chunkShow h+-}++--+-- Support for decoding form data+--++-- | Data structure representing the name and metadata of a control in+-- a submitted form.+data FormField = FormField {+      ffName :: !S.ByteString+    -- ^ Name of the form control being processed+    , ffParams :: ![(S.ByteString, S.ByteString)]+    -- ^ Parameters from the @Content-Disposition:@ header.  This only+    -- applies to @Content-Type: multipart/form-data@, and will be+    -- empty for forms of type application/x-www-form-urlencoded or+    -- forms submitted in the URL parameters of a GET request.+    , ffHeaders :: ![(S.ByteString, S.ByteString)]+    -- ^ Extra headers following the @Content-Disposition:@ header of+    -- a @multipart/form-data@ post.  Empty for other kinds of form+    -- submission.+    } deriving (Show)++defaultFormField :: FormField+defaultFormField = FormField {+                     ffName = S.empty+                   , ffParams = []+                   , ffHeaders = []+                   }++-- | Parses a form, and folds a function over each control.  The value+-- of each control is available through Iteratee input.  Thus, you can+-- extract the submitted value with 'pureI', or redirect it elsewhere+-- by executing another 'Iter'.  For example, to parse a form and+-- print it to standard output (without buffering possibly large file+-- uploads in memory):+--+-- >  do let docontrol _ field = do+-- >           liftIO $ putStrLn $+-- >               "The value of " ++ (S8.unpack $ ffName field) ++ " is:"+-- >           stdoutI                   -- Send form value to standard output+-- >           liftIO $ putStrLn "\n"+-- >     foldForm req docontrol ()+--+-- Or to produce a list of (field, value) pairs, you can say something+-- like:+-- +-- >  do let docontrol acc field = do+-- >           val <- pureI+-- >           return $ (ffName field, val) : acc+-- >     foldForm req docontrol []+--+-- Note that for POSTed forms of enctype+-- @application/x-www-form-urlencoded@, @foldForm@ will read to the+-- end of its input.  Thus, it is important to ensure @foldForm@ is+-- called from within an 'inumHttpBody' enumerator (which is+-- guaranteed by 'inumHttpServer').+foldForm :: (Monad m) =>+            HttpReq+         -> (a -> FormField -> Iter L.ByteString m a)+         -> a+         -> Iter L.ByteString m a+foldForm req = case reqContentType req of+                 Nothing -> foldQuery req+                 Just (mt, _) | mt == urlencoded -> foldUrlencoded req+                 Just (mt, _) | mt == multipart  -> foldMultipart req+                 _ -> \_ _ -> throwParseI "foldForm: invalid Content-Type"+++--+-- application/x-www-form-urlencoded decoding+--+-- The HTML 4.01 spec says:+--+--   This is the default content type. Forms submitted with this+--   content type must be encoded as follows:+--       +--    1. Control names and values are escaped. Space characters are+--       replaced by `+', and then reserved characters are escaped as+--       described in [RFC1738], section 2.2: Non-alphanumeric characters+--       are replaced by `%HH', a percent sign and two hexadecimal digits+--       representing the ASCII code of the character. Line breaks are+--       represented as "CR LF" pairs (i.e., `%0D%0A').+-- +--    2. The control names/values are listed in the order they appear in+--       the document. The name is separated from the value by `=' and+--       name/value pairs are separated from each other by `&'.+--+-- RFC 1738 says:+--   ...only alphanumerics, the special characters "$-_.+!*'(),", and+--   reserved characters used for their reserved purposes may be used+--   unencoded within a URL.+--+-- On the other hand, RFC 3986 says the following are reserved:+--   :/?#[]@!$&'()*+,;=+--+-- And that the only unreserved characters are:+--   unreserved  = ALPHA / DIGIT / "-" / "." / "_" / "~"+--+-- In practice, browsers seem to encode everything (including "~"),+-- except for ALPHA, DIGIT, and the four characters:+--   -._*+--+-- Given the confusion, we'll just accept almost everything except '&'+-- and '='.++urlencoded :: S+urlencoded = S8.pack "application/x-www-form-urlencoded"++urlencTab :: UArray Word8 Bool+urlencTab = listArray (0, 127) $ fmap ok ['\0'..'\177']+    where ok c | c <= ' '        = False+               | c >= '\177'     = False+               | c `elem` "%+&=" = False+               | otherwise       = True++controlI :: (Monad m) => Iter L m (S, S)+controlI = flip (<?>) "form control NAME=VALUE" $ do+  name <- encval+  value <- (char '=' >> encval) <|> nil+  return (name, value)+    where+      encval = liftM strictify $ concatI $+               someI (percent_decode (urlencTab !))+               <|> L8.singleton ' ' <$ char '+'++{-+urlencodedFormI :: (Monad m) => Iter L m [(S,S)]+urlencodedFormI = sepBy controlI (char '&')+-}++inumBind :: (ChunkData t, Monad m) =>+            Iter t m a -> (a -> Iter t m a) -> Iter t m a+inumBind m k = tryRI m >>= either reRunIter k+infixl 1 `inumBind`++foldControls :: (Monad m) => (a -> FormField -> Iter L m a) -> a -> Iter L m a+foldControls f z =+    controlI \/ return z $ \(k, v) ->+    inumPure (L.fromChunks [v]) .|+             f z defaultFormField { ffName = k } `inumBind` \a ->+    char '&' \/ return a $ \_ -> foldControls f a++foldUrlencoded :: (Monad m) =>+                  HttpReq -> (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+foldQuery req f z = inumPure (L.fromChunks [reqQuery req]) .| foldControls f z++--+-- multipart/form-data decoding, as specified throughout the following:+--+-- RFC 2045 - MIME part 1, including Content-Type header grammar+-- RFC 2046 - MIME part 2, including multipart boundary grammar+-- RFC 2047 - (splitting up parameters - not implemented yet here)+-- RFC 2183 - The Content-Disposition header grammar+-- +-- Less useful, but normative:+--+-- RFC 2388 - multipart/form data spec (mostly references above)+--++{-+-- | Mime boundary characters+bcharTab :: UArray Word8 Bool+bcharTab = listArray (0,127) $ fmap isBChar ['\0'..'\177']+    where isBChar c = isAlphaNum c || elem c otherBChars+          otherBChars = "'()/+_,-./:=? "+-}++multipart :: S+multipart = S8.pack "multipart/form-data"++reqBoundary :: HttpReq -> 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 req = case reqBoundary req of+                   Just b  -> findpart $ S8.pack "--" `S8.append` b+                   Nothing -> return Nothing+  where+    nextLine :: (Monad m) => Iter L m ()+    nextLine = skipWhileI (\c -> c `elem` map eord " \t\r") >>+               char '\n' >> return ()+    findpart b = do+      match $ L.fromChunks [b]+      done <- ((string "--" >> return True) <|> return False) <* nextLine+      if done then return Nothing else Just <$> parsepart+    parsepart = do+      cdhdr@(field, val) <- hdr_field_val+      inumPure field .|$ stringCase "Content-Disposition"+      parms <- inumPure (L.fromChunks [val]) .|$+               sepBy (parameter <|> (token >>= \t -> return (t, S.empty)))+                     (olws >> char ';')+      hdrs <- many hdr_field_val+      crlf+      return FormField {+                   ffName = maybe S.empty id $ lookup (S8.pack "name") parms+                 , ffParams = parms+                 , ffHeaders = cdhdr:hdrs+                 }++inumMultipart :: (Monad m) => HttpReq -> Inum L L m a+inumMultipart req iter = flip mkInumM (iter <* nullI) $ do+  b <- bstr+  ipipe $ inumStopString b+  (crlf <?> chunkShow b)+    where+      bstr = case reqBoundary req of+               Just b  -> return $ S8.pack "\r\n--" `S8.append` b+               Nothing -> throwParseI "inumMultipart: no parts"++foldMultipart :: (Monad m) =>+                 HttpReq -> (a -> FormField -> Iter L m a) -> a -> Iter L m a+foldMultipart req f z = multipartI req >>= doPart+    where+      doPart Nothing = return z+      doPart (Just mp) =+          inumMultipart req .| (f z mp <* nullI) `inumBind` \a ->+          foldMultipart req f a+++--+-- HTTP Response support+--++-- | HTTP status code and text description of response, for the first+-- line of an HTTP response message.  A bunch of pre-defined statuses+-- from RFC 2616 are supplied under the names 'stat200', 'stat404',+-- 'stat500', etc.+data HttpStatus = HttpStatus !Int !S.ByteString deriving Show++mkStat :: Int -> String -> HttpStatus+mkStat n s = HttpStatus n $ S8.pack s++fmtStat :: HttpStatus -> L+fmtStat (HttpStatus n s) = L.fromChunks [+                            S8.pack $ "HTTP/1.1 " ++ show n ++ " "+                           , s, S8.pack "\r\n"]++stat100, stat200+           , stat301, stat302, stat303, stat304+           , stat400, stat401, stat403, stat404, stat405+           , stat500, stat501 :: HttpStatus+stat100 = mkStat 100 "Continue"+stat200 = mkStat 200 "OK"+stat301 = mkStat 301 "Moved Permanently"+stat302 = mkStat 302 "Found"+stat303 = mkStat 303 "See Other"+stat304 = mkStat 304 "Not Modified"+stat400 = mkStat 400 "Bad Request"+stat401 = mkStat 401 "Unauthorized"+stat403 = mkStat 403 "Forbidden"+stat404 = mkStat 404 "Not Found"+stat405 = mkStat 405 "Method not allowed"+stat500 = mkStat 500 "Internal Server Error"+stat501 = mkStat 501 "Not Implemented"++-- | A data structure describing an HTTP response message to be sent,+-- parameterized by the Monad in which the response will be written to+-- the network.+data HttpResp m = HttpResp {+      respStatus :: !HttpStatus+    -- ^ The response status.+    , respHeaders :: ![S.ByteString]+    -- ^ Headers to send back+    , respChunk :: !Bool+    -- ^ True if the message body should be passed through+    -- 'inumToChunks' and a \"@Transfer-Encoding: chunked@\" header+    -- should be added.  Generally this should be 'True' unless you+    -- have added a @Content-Length@ header, manually set up chunk+    -- encoding by fusing it in 'respBody', or are not returning a+    -- message body with the reply.+    , respBody :: !(Onum L.ByteString m (IterR L.ByteString m ()))+    -- ^ 'Onum' producing the message body.  Use 'inumNull' (which is+    -- an empty 'Inum') to produce an empty body for responses that do+    -- not contain a body.+    }++respAddHeader :: S.ByteString -> HttpResp m -> HttpResp m+respAddHeader hdr resp = resp { respHeaders = hdr : respHeaders resp }++instance Show (HttpResp m) where+    showsPrec _ resp rest = "HttpResp (" ++ show (respStatus resp)+                            ++ ") " ++ show (respHeaders resp) ++ rest++-- | An empty HTTP response, to which you must add headers and+-- possibly a message body.+defaultHttpResp :: (Monad m) => HttpResp m+defaultHttpResp = HttpResp { respStatus = stat200+                           , respHeaders = []+                           , respChunk = True+                           , respBody = inumNull+                           }++-- | Generate an 'HttpResp' without a body.+mkHttpHead :: (Monad m) => HttpStatus -> HttpResp m+mkHttpHead stat = HttpResp { respStatus = stat+                           , respHeaders = []+                           , respChunk = False+                           , respBody = inumNull }++-- | Generate an 'HttpResp' with a body of type @text/html@.+mkHtmlResp :: (Monad m) =>+              HttpStatus+           -> L.ByteString      -- ^ Body as a pure lazy 'L.ByteString'+           -> HttpResp m+mkHtmlResp stat html = resp+    where resp0 = mkHttpHead stat `asTypeOf` resp+          ctype = S8.pack "Content-Type: text/html"+          len = S8.pack $ "Content-Length: " ++ show (L8.length html)+          resp  = resp0 { respHeaders = respHeaders resp0 ++ [ctype, len]+                        , respBody = inumPure html+                        }++-- | Make an 'HttpResp' of an arbitrary content-type based on a pure+-- lazy 'L.ByteString'.  Since the result is pure, this function first+-- measures its length so as to set a Content-Length header instead of+-- using HTTP chunk encoding.+mkContentLenResp :: (Monad m)+                 => HttpStatus+                 -> String       -- ^ Value for Content-Type: header+                 -> L.ByteString -- ^ Contents of response body+                 -> HttpResp m+mkContentLenResp stat ctype body =+  HttpResp { respStatus = stat+           , respHeaders = [contentType, contentLength]+           , respChunk = False+           , respBody = inumPure body }+ where+  contentType = S8.pack $ "Content-Type: " ++ ctype+  contentLength = S8.pack $ "Content-Length: " ++ show (L8.length body)++-- | Make an 'HttpResp' of an arbitrary content-type based on an+-- 'Onum' that will dynamically generate the message body.  Since the+-- message body is generated dynamically, the reply will use an HTTP+-- chunk encoding.+mkOnumResp :: (Monad m)+           => HttpStatus+           -> String+           -- ^ Value for Content-Type header:+           -> Onum L.ByteString m (IterR L.ByteString m ())+           -- ^ 'Onum' that will generate reply body dynamically.+           -> HttpResp m+mkOnumResp stat ctype body =+  HttpResp { respStatus = stat+           , respHeaders = [contentType]+           , respChunk = True+           , respBody = body }+ where+  contentType = S8.pack $ "Content-Type: " ++ ctype++htmlEscapeChar :: Char -> Maybe String+htmlEscapeChar '<'  = Just "&lt;"+htmlEscapeChar '>'  = Just "&gt;"+htmlEscapeChar '&'  = Just "&amp;"+htmlEscapeChar '"'  = Just "&quot;"+htmlEscapeChar '\'' = Just "&amp;"+htmlEscapeChar _   = Nothing++htmlEscape :: String -> L.ByteString+htmlEscape str = L8.unfoldr next (str, "")+    where+      next (s, h:t)  = Just (h, (s, t))+      next (h:t, "") = maybe (Just (h, (t, ""))) (curry next t) $+                       htmlEscapeChar h+      next ("", "")  = Nothing++-- | Generate a 301 (redirect) response.+resp301 :: (Monad m) => String -> HttpResp m+resp301 target =+    respAddHeader (S8.pack $ "Location: " ++ target) $ mkHtmlResp stat301 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>301 Moved Permanently</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>Moved Permanently</H1>\n\+                  \<P>The document has moved <A HREF=\""+                 , htmlEscape target+                 , L8.pack "\">here</A>.</P>\n"]++-- | Generate a 303 (see other) response.+resp303 :: (Monad m) => String -> HttpResp m+resp303 target =+    respAddHeader (S8.pack $ "Location: " ++ target) $ mkHtmlResp stat303 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>303 See Other</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>See Other</H1>\n\+                  \<P>The document has moved <A HREF=\""+                 , htmlEscape target+                 , L8.pack "\">here</A>.</P>\n"]++-- | Generate a 403 (forbidden) response.+resp403 :: (Monad m) => HttpReq -> HttpResp m+resp403 req = mkHtmlResp stat403 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>403 Forbidden</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>Forbidden</H1>\n\+                  \<P>You don't have permission to access "+                 , htmlEscape $ S8.unpack (reqNormalPath req)+                 , L8.pack " on this server.</P>\n\+                           \</BODY></HTML>\n"]++-- | Generate a 404 (not found) response.+resp404 :: (Monad m) => HttpReq -> HttpResp m+resp404 req = mkHtmlResp stat404 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>404 Not Found</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>Not Found</H1>\n\+                  \<P>The requested URL "+                 , htmlEscape $ S8.unpack (reqNormalPath req)+                 , L8.pack " was not found on this server.</P>\n\+                           \</BODY></HTML>\n"]++-- | Generate a 405 (method not allowed) response.+resp405 :: (Monad m) => HttpReq -> HttpResp m+resp405 req = mkHtmlResp stat405 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>405 Method Not Allowed</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>Method Not Allowed</H1>\n\+                  \<P>The requested method "+                 , L.fromChunks [reqMethod req]+                 , L8.pack " is not allowed for the URL "+                 , htmlEscape $ S8.unpack (reqNormalPath req)+                 , L8.pack ".</P>\n\+                           \</BODY></HTML>\n"]++-- | Generate a 500 (internal server error) response.+resp500 :: (Monad m) => String -> HttpResp m+resp500 msg = mkHtmlResp stat500 html+    where html = L8.concat+                 [L8.pack+                  "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n\+                  \<HTML><HEAD>\n\+                  \<TITLE>500 Internal Server Error</TITLE>\n\+                  \</HEAD><BODY>\n\+                  \<H1>Internal Server Error</H1>\n\+                  \<P>"+                 , htmlEscape msg+                 , L8.pack "</P>\n</BODY></HTML>\n"]++-- | Format and enumerate a response header and body.+enumHttpResp :: (Monad m) =>+                HttpResp m+             -> Maybe UTCTime   -- ^ Time for @Date:@ header (if desired)+             -> Onum L.ByteString m ()+enumHttpResp resp mdate = inumPure fmtresp `cat` (respBody resp |. maybeChunk)+    where+      fmtresp = L.append (fmtStat $ respStatus resp) hdrs+      hdrs = foldr (L.append . hdr) (L8.pack "\r\n") $+             (if respChunk resp+              then ((S8.pack "Transfer-Encoding: chunked") :)+              else id) $+             (maybe id (\t -> (S8.pack ("Date: " ++ http_fmt_time t) :)) mdate)+             (respHeaders resp)+      hdr h = L.fromChunks [h, S8.pack "\r\n"]+      maybeChunk = if respChunk resp then inumToChunks else inumNop++-- | 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)++-- | 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)+    }++-- | Generate a null 'HttpServerConf' structure with no logging and no+-- Date header.+nullHttpServer :: (Monad m) => HttpRequestHandler m -> HttpServerConf m+nullHttpServer handler = HttpServerConf {+                           srvLogger = const $ return ()+                         , srvDate = return Nothing+                         , srvHandler = handler+                         }++-- | 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 handler = HttpServerConf {+                         srvLogger = liftIO . hPutStrLn stderr+                       , srvDate = liftIO $ Just `liftM` getCurrentTime+                       , srvHandler = handler+                       }++-- | An 'Inum' that behaves like an HTTP server.  The file+-- @Examples/httptest.hs@ that comes with the iterIO distribution+-- gives an example of how to use this function.+inumHttpServer :: (Monad m) =>+                  HttpServerConf m  -- ^ Server configuration+               -> Inum L.ByteString L.ByteString m ()+inumHttpServer server = mkInumM loop+    where+      loop = do+        eof <- atEOFI+        unless eof doreq+      doreq = do+        req <- httpReqI+        let handler = srvHandler server req+        resp <- liftI $ inumHttpBody req .|+                (catchI handler errHandler <* nullI)+        now <- liftI $ srvDate server+        tryI (irun $ enumHttpResp resp now) >>=+             either (fatal . fst) (const loop)+      errHandler e@(SomeException _) _ = do+        srvLogger server $ "Response error: " ++ show e+        return $ resp500 $ show e+      fatal e@(SomeException _) = do+        liftI $ srvLogger server $ "Reply error: " ++ show e+        return ()+++{-++--+-- Everything below here is crap for testing+--++formTest :: L -> IO ()+formTest b = inumPure b |$ handleReq+ where+  handleReq = do+    req <- httpReqI+    parts <- foldForm req getPart []+    liftIO $ putStrLn $ "### Summary\n" ++ show parts+  getPart result mp = do+    liftIO $ do putStrLn $ "### Part " ++ show (length result); print mp; putStrLn ""+    stdoutI+    liftIO $ putStr "\n\n"+    return (mp:result)++formTestMultipart :: IO ()+formTestMultipart = formTest postReq++formTestUrlencoded :: IO ()+formTestUrlencoded = formTest postReqUrlencoded++{-+dumpCtl :: () -> Multipart -> Iter L IO ()+dumpCtl () mp = do+  liftIO $ S.putStr (ffName mp) >> putStrLn ":"+  stdoutI+  liftIO $ putStrLn "\n"++x :: L+x = L8.pack "p1=v1&p2=v2"+-}++mptest :: IO ()+mptest = inumPure postReq |$ (httpReqI >>= getHead)+    where+      getHead req = do+        mmp <- multipartI req+        case mmp of+          Nothing -> return ()+          Just mp -> do liftIO $ print mp+                        (inumMultipart req ) .| stdoutI+                        (inumMultipart req ) .| nullI+                        (inumMultipart req ) .| nullI+                        (inumMultipart req ) .| nullI+                        (inumMultipart req ) .| nullI+                        crlf+                        liftIO $ putStr "\n\n"+                        getHead req++mptest' :: IO ()+mptest' = inumPure postReq |$ (httpReqI >>= getParts 0)+    where+      getParts :: (MonadIO m) => Integer -> HttpReq -> Iter L m ()+      getParts n req = do+        mmp <- multipartI req+        case mmp of+          Nothing -> return ()+          Just mp -> do liftIO $ do+                          putStrLn $ "### Part " ++ show n+                          print mp+                          putStrLn ""+                        (inumMultipart req) .| stdoutI+                        liftIO $ putStr "\n\n"+                        getParts (n+1) req+ ++postReq :: L+postReq = L8.pack+ "POST /testSubmit HTTP/1.1\n\+ \Host: localhost:8000\n\+ \User-Agent: Mozilla/5.0 (X11; U; Linux i686 (x86_64); en-US; rv:1.9.2.8) Gecko/20100722 Firefox/3.6.8\n\+ \Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8\n\+ \Accept-Language: en-us,en;q=0.5\n\+ \Accept-Encoding: gzip,deflate\n\+ \Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n\+ \Keep-Alive: 115\n\+ \Connection: keep-alive\n\+ \Content-Type: multipart/form-data; boundary=---------------------------28986267117678495841915281966\n\+ \Content-Length: 561\n\+ \\n\+ \-----------------------------28986267117678495841915281966\n\+ \Content-Disposition: form-data; name=\"justatestkey\"\n\+ \\n\+ \nothing\r\n\+ \-----------------------------28986267117678495841915281966\n\+ \Content-Disposition: form-data; name=\"hate\"\n\+ \\n\+ \666\r\n\+ \-----------------------------28986267117678495841915281966\n\+ \Content-Disposition: form-data; name=\"file1\"; filename=\"x\"\n\+ \Content-Type: application/octet-stream\n\+ \\n\+ \search scs.stanford.edu uun.org\n\+ \nameserver 127.0.0.1\n\+ \nameserver 64.81.79.2\n\+ \nameserver 216.231.41.2\n\+ \\r\n\+ \-----------------------------28986267117678495841915281966--\n"++postReqUrlencoded :: L+postReqUrlencoded = L8.pack+ "POST /testSubmit HTTP/1.1\n\+ \Host: localhost:8000\n\+ \User-Agent: Mozilla/5.0 (X11; U; Linux i686 (x86_64); en-US; rv:1.9.2.8) Gecko/20100722 Firefox/3.6.8\n\+ \Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8\n\+ \Accept-Language: en-us,en;q=0.5\n\+ \Accept-Encoding: gzip,deflate\n\+ \Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n\+ \Keep-Alive: 115\n\+ \Connection: keep-alive\n\+ \Content-Type: application/x-www-form-urlencoded\n\+ \Content-Length: 11\n\+ \\n\+ \p1=v1&p2=v2"+++encReq :: L+encReq = L8.pack "justatestkey=nothing&hate=666&file1=mtab"++-}

@@ -0,0 +1,380 @@++module Data.IterIO.HttpRoute+    (HttpRoute(..)+    , runHttpRoute, addHeader+    , routeConst, routeFn, routeReq+    , routeMethod, routeHost, routeTop+    , HttpMap, routeMap, routeMap', routeName, routePath, routeVar+    , mimeTypesI, dirRedir, routeFileSys, FileSystemCalls(..), routeGenFileSys+    ) where++import           Control.Monad+import           Control.Monad.Trans+import           Data.Char (toLower)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.Map as Map+import           Data.Maybe+import           Data.Monoid+import           Data.Time (UTCTime)+import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import           System.FilePath+import           System.IO+import           System.IO.Error (isDoesNotExistError)+import           System.Posix.Files+import           System.Posix.IO+import           System.Posix.Types++import           Data.IterIO+import           Data.IterIO.Http+import           Data.IterIO.Parse++--+-- Request routing+--++-- | Simple HTTP request routing structure for 'inumHttpServer'.  This+-- is a wrapper around a function on 'HttpReq' structures.  If the+-- function accepts the 'HttpReq', it returns 'Just' a response+-- action.  Otherwise it returns 'Nothing'.+--+-- @HttpRoute@ is a 'Monoid', and hence can be concatenated with+-- 'mappend' or 'mconcat'.  For example, you can say something like:+--+-- > simpleServer :: Iter L.ByteString IO ()  -- Output to web browser+-- >              -> Onum L.ByteString IO ()  -- Input from web browser+-- >              -> IO ()+-- > simpleServer iter enum = enum |$ inumHttpServer server .| iter+-- >     where htdocs = "/var/www/htdocs"+-- >           server = ioHttpServer $ runHttpRoute routing+-- >           routing = mconcat [ routeTop $ routeConst $ resp301 "/start.html"+-- >                             , routeName "apps" $ routeMap apps+-- >                             , routeFileSys mimeMap "index.html" htdocs+-- >                             ]+-- >           apps = [ ("app1", routeFn app1)+-- >                  , ("app2", routeFn app2) ]+-- > +-- > app1 :: (Monad m) => HttpReq -> Iter L.ByteString m (HttpResp m)+-- > app1 = ...+--+-- The above function will redirect requests for @/@ to the URL+-- @/start.html@ using an HTTP 301 (Moved Permanently) response.  Any+-- request for a path under @/apps/@ will be redirected to the+-- functions @app1@, @app2@, etc.  Finally, any other file name will+-- 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)))++runHttpRoute :: (Monad m) =>+                HttpRoute m -> HttpReq -> Iter L.ByteString m (HttpResp m)+runHttpRoute (HttpRoute route) rq = fromMaybe (return $ resp404 rq) $ route rq++instance Monoid (HttpRoute m) where+    mempty = HttpRoute $ const Nothing+    mappend (HttpRoute a) (HttpRoute b) =+        HttpRoute $ \req -> a req `mplus` b req++popPath :: Bool -> HttpReq -> HttpReq+popPath isParm req =+    case reqPathLst req of+      h:t -> req { reqPathLst = t+                 , reqPathCtx = reqPathCtx req ++ [h]+                 , reqPathParams = if isParm then h : reqPathParams req+                                             else reqPathParams req+                 }+      _   -> error "Data.IterIO.Http.popPath: empty path"++-- | Prepend a header field to the response produced by an 'HttpRoute'+-- if that 'HttpRoute' is successful.  For example, to let clients+-- cache static data for an hour, you might use:+--+-- @+--   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 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 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 fn = HttpRoute $ Just . fn++-- | Select a route based on some arbitrary function of the request.+-- For most purposes, the existing predicates ('routeName',+-- 'routePath', etc.) should be fine, but occationally you might want+-- to define a custom predicate.  For example, to reject methods other+-- then \"GET\" or \"POST\" at the top of your route, you could say:+--+-- @+--      myRoute = 'mconcat' [ rejectBadMethod+--                        , otherRoute1+--                        , ...+--                        ]+--      ...+--+--rejectBadMethod :: 'HttpRoute' m+--rejectBadMethod =+--      routeReq $ \req ->+--          case 'reqMethod' req of+--            s | s == 'S8.pack' \"GET\" || s == 'S8.pack' \"PUT\" ->+--                  'mempty'                   {- reject route, falling through+--                                                      to rest of myRoute -}+--            _ -> 'routeConst' $ 'resp405' req  {- reject request -}+-- @+routeReq :: (HttpReq -> HttpRoute m) -> HttpRoute m+routeReq fn = HttpRoute $ \req ->+                let (HttpRoute route) = fn req+                in route req+++-- | Route the root directory (/).+routeTop :: HttpRoute m -> HttpRoute m+routeTop (HttpRoute route) = HttpRoute $ \req ->+                             if null $ reqPathLst req then route req+                             else Nothing++-- | 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+routeHost host (HttpRoute route) = HttpRoute check+    where shost = S8.pack $ map toLower host+          check req | reqHost req /= shost = Nothing+                    | otherwise            = route req++-- | 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+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)]++-- | @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+    where+      check req = case reqPathLst req of+                    h:_ -> maybe Nothing+                           (\(HttpRoute route) -> route $ popPath False req)+                           (Map.lookup h rmap)+                    _   -> Nothing+      packfirst (a, b) = (S8.pack a, b)+      rmap = Map.fromListWithKey nocombine $ map packfirst lst+      nocombine k _ _ = error $ "routeMap: duplicate key for " ++ S8.unpack k++-- | Routes a specific directory name, like 'routeMap' for a singleton+-- map.+routeName :: String -> HttpRoute m -> HttpRoute m+routeName name (HttpRoute route) = HttpRoute check+    where sname = S8.pack name+          headok (h:_) | h == sname = True+          headok _                  = False+          check req | headok (reqPathLst req) = route $ popPath False req+          check _                             = Nothing++-- | Routes a specific path, like 'routeName', except that the path+-- can include several directories.+routePath :: String -> HttpRoute m -> HttpRoute m+routePath path route = foldr routeName route dirs+    where dirs = case splitDirectories path of+                   "/":t -> t+                   t     -> t++-- | Matches any directory name, but additionally pushes it onto the+-- 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 route) = HttpRoute check+    where check req = case reqPathLst req of+                        _:_ -> route $ popPath True req+                        _   -> Nothing++--+-- Routing to Filesystem+--++-- | Parses @mime.types@ file data.  Returns a function mapping file+-- suffixes to mime types.  The argument is a default mime type for+-- suffixes to do not match any in the mime.types data.  (Reasonable+-- defaults might be @\"text\/html\"@, @\"text\/plain\"@, or, more+-- pedantically but less usefully, @\"application\/octet-stream\"@.)+--+-- Since this likely doesn't change, it is convenient just to define+-- it once in your program, for instance with something like:+--+-- > mimeMap :: String -> S8.ByteString+-- > mimeMap = unsafePerformIO $ do+-- >             path <- findMimeTypes ["mime.types"+-- >                                   , "/etc/mime.types"+-- >                                   , "/var/www/conf/mime.types"]+-- >             enumFile path |$ mimeTypesI "application/octet-stream"+-- >     where+-- >       findMimeTypes (h:t) = do exist <- fileExist h+-- >                                if exist then return h else findMimeTypes t+-- >       findMimeTypes []    = return "mime.types" -- cause error+mimeTypesI :: (Monad m) =>+              String+           -> Iter S8.ByteString m (String -> S8.ByteString)+mimeTypesI deftype = do+  mmap <- Map.fromList <$> concatI ((mimeLine <|> nil) <* eol)+  return $ \suffix -> maybe (S8.pack deftype) id $ Map.lookup suffix mmap+    where+      mimeLine = do+        typ <- word+        many $ do space; ext <- word; return (S8.unpack ext, typ)+      word = while1I $ \c -> c > eord ' ' && c <= eord '~'+      space = skipWhile1I $ \c -> c == eord ' ' || c == eord '\t'+      comment = char '#' >> skipWhileI (/= eord '\n')+      eol = do+        optionalI space+        optionalI comment+        optionalI (char '\r'); char '\n'++-- | An abstract representation of file system calls returning an+-- opaque handle type @h@ in an 'Iter' parameterized by an arbitrary+-- 'Monad' @m@.  This representation allows one to use+-- 'routeGenFileSys' in a monad that is not an instance of 'MonadIO'.+data FileSystemCalls h m = FileSystemCalls {+      fs_stat :: !(FilePath -> Iter L.ByteString m FileStatus)+    -- ^ Return file attributes.+    , fs_open :: !(FilePath -> Iter L.ByteString m h)+    -- ^ Open file and return an opaque handle of type @h@.+    , fs_close :: !(h -> Iter L.ByteString m ())+    -- ^ Close an open file.  You must call this unless you apply the+    -- enumerator returned by @fs_enum@.+    , fs_fstat :: !(h -> Iter L.ByteString m FileStatus)+    -- ^ Return the attributes of an open file.+    , fs_enum :: !(h -> Iter L.ByteString m+                        (Onum L.ByteString m (IterR L.ByteString m ())))+    -- ^ Enumerate the contents of an open file, then close the file.+    -- If you apply the 'Onum' returned by @fs_enum@, you do not need+    -- to call @fs_close@.+    }++-- | Default file system calls for instances of the @MonadIO@ class.+defaultFileSystemCalls :: (MonadIO m) => FileSystemCalls Fd m+defaultFileSystemCalls = FileSystemCalls { fs_stat = liftIO . getFileStatus+                                         , fs_open = liftIO . pathToFd+                                         , fs_close = liftIO . closeFd+                                         , fs_fstat = liftIO . getFdStatus+                                         , fs_enum = liftIO . fdToOnum+                                         }+    where pathToFd path = openFd path ReadOnly Nothing defaultFileFlags+          fdToOnum fd = do h <- fdToHandle fd+                           return $ enumHandle h `inumFinally` liftIO (hClose h)++-- | @dirRedir indexFileName@ redirects requests to the URL formed by+-- appending @\"/\" ++ indexFileName@ to the requested URL.+dirRedir :: (Monad m) => FilePath -> FilePath -> HttpRoute m+dirRedir index _path = routeFn $ \req -> return $+                       resp301 $ S8.unpack (reqNormalPath req) ++ '/':index++modTimeUTC :: FileStatus -> UTCTime+modTimeUTC = posixSecondsToUTCTime . realToFrac . modificationTime++-- | Route a request to a directory tree in the file system.  It gets+-- the Content-Length from the target file's attributes (after opening+-- the file).  Thus, overwriting files on an active server could cause+-- problems, while renaming new files into place should be safe.+routeFileSys :: (MonadIO m) =>+                (String -> S8.ByteString)+             -- ^ Map of file suffixes to mime types (see 'mimeTypesI')+             -> (FilePath -> HttpRoute m)+             -- ^ Handler to invoke when the URL maps to a directory+             -- in the file system.  Reasonable options include:+             --+             -- * @('const' 'mempty')@ to do nothing, which results in a+             --   403 forbidden,+             --+             -- * @('dirRedir' \"index.html\")@ to redirect directory+             --   accesses to an index file, and+             --+             -- * a recursive invocation such as @(routeFileSys+             -- typemap . (++ \"/index.html\"))@ to re-route the+             -- request directly to an index file.+             -> FilePath+             -- ^ Pathname of directory to serve from file system+             -> HttpRoute m+routeFileSys = routeGenFileSys defaultFileSystemCalls++-- | A generalized version of 'routeFileSys' that takes a+-- 'FileSystemCalls' object and can therefore work outside of the+-- 'MonadIO' monad.  Other than the 'FileSystemCalls' object, the+-- arguments and their meaning are identical to 'routeFileSys'.+routeGenFileSys :: (Monad m) =>+                   FileSystemCalls h m+                -> (String -> S8.ByteString)+                -> (FilePath -> HttpRoute m)+                -> FilePath+                -> HttpRoute m+routeGenFileSys fs typemap index dir0 = HttpRoute $ Just . check+    where+      dir = if null dir0 then "." else dir0+      checkErr req e _ | isDoesNotExistError e = return $ resp404 req+                       | otherwise             = return $ resp500 (show e)+      check req = flip catchI (checkErr req) $ do+        let path = dir ++ concatMap (('/' :) . S8.unpack) (reqPathLst req)+        st <- fs_stat fs path+        case () of+          _ | isRegularFile st     -> doFile req path st+            | not (isDirectory st) -> return $ resp404 req+            | otherwise -> runHttpRoute+                           (index path `mappend` routeConst (resp403 req)) req+      doFile req path st+          | reqMethod req == S8.pack "GET"+            && maybe True (< (modTimeUTC st)) (reqIfModifiedSince req) = do+              fd <- fs_open fs path+              -- Use attributes from opened file in case file name changes+              st' <- fs_fstat fs fd `onExceptionI` fs_close fs fd+              if isRegularFile st'+                then do body <- fs_enum fs fd `onExceptionI` fs_close fs fd+                        return $ resp { respHeaders = mkHeaders req st'+                                      , respBody = body }+                else do fs_close fs fd -- File no longer file -- re-try+                        check req+          | reqMethod req == S8.pack "GET" =+              return $ resp { respStatus = stat304 }+          | reqMethod req == S8.pack "HEAD" =+              return $ resp { respStatus = stat200 }+          | otherwise = return $ resp405 req+          where resp = defaultHttpResp { respChunk = False+                                       , respHeaders = mkHeaders req st }++      mkHeaders req st =+          [ S8.pack $ "Last-Modified: " ++ (http_fmt_time $ modTimeUTC st)+          , S8.pack $ "Content-Length: " ++ (show $ fileSize st)+          , S8.pack "Content-Type: " `S8.append` typemap (fileExt req) ]+      fileExt req =+          drop 1 $ takeExtension $ case reqPathLst req of+                                     [] -> dir+                                     l  -> S8.unpack $ last l++

@@ -0,0 +1,1114 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Data.IterIO.Inum+    (-- * Base types+     Inum, Onum+    -- * Concatenation and fusing operators+    , (|$), (.|$), cat, lcat, (|.), (.|)+    -- * Exception functions+    , inumCatch, inumFinally, inumOnException+    , resumeI, verboseResumeI+    -- * Simple enumerator construction function+    -- $mkInumIntro+    , ResidHandler, CtlHandler+    , mkInumC, mkInum, mkInumP+    , inumBracket+    -- * Utilities+    , pullupResid+    , noCtl, passCtl, consCtl, mkCtl, mkFlushCtl+    , runIterM, runIterMC, runInum+    -- * Some basic Inums+    , inumNop, inumNull, inumPure, enumPure, inumRepeat+    -- * Enumerator construction monad+    -- $mkInumMIntro+    , InumM, mkInumM, mkInumAutoM+    , setCtlHandler, setAutoEOF, setAutoDone, addCleanup, withCleanup+    , ifeed, ifeed1, ipipe, irun, irepeat, ipopresid, idone+    ) where++import Prelude hiding (null)+import Control.Exception (Exception(..))+import Control.Monad+import Control.Monad.Trans+import Data.Maybe+import Data.Monoid+import Data.Typeable+import System.Environment (getProgName)+import System.IO++import Data.IterIO.Iter+import Data.IterIO.Trans++--+-- Enumerator types+--++-- | The type of an /iterator-enumerator/, which transcodes data from+-- some input type @tIn@ to some output type @tOut@.  An @Inum@ acts+-- as an 'Iter' when consuming data, then acts as an enumerator when+-- feeding transcoded data to another 'Iter'.+--+-- At a high level, one can think of an @Inum@ as a function from+-- 'Iter's to 'IterR's, where an @Inum@'s input and output types are+-- different.  A simpler-seeming alternative to @Inum@ might have+-- been:+--+-- > type Inum' tIn tOut m a = Iter tOut m a -> Iter tIn m a+--+-- In fact, given an @Inum@ object @inum@, it is possible to construct+-- a function of type @Inum'@ with @(inum '.|')@.  But sometimes one+-- might like to concatenate @Inum@s.  For instance, consider a+-- network protocol that changes encryption or compression modes+-- midstream.  Transcoding is done by @Inum@s.  To change transcoding+-- methods after applying an @Inum@ to an iteratee requires the+-- ability to \"pop\" the iteratee back out of the @Inum@ so as to be+-- able to hand it to another @Inum@.  @Inum@'s return type (@Iter tIn+-- m (IterR tOut m a)@ as opposed to @Iter tIn m a@) allows the+-- monadic bind operator '>>=' to accomplish this popping in+-- conjunction with the 'tryRI' and 'reRunIter' functions.+--+-- All @Inum@s must obey the following two rules.+--+-- 1. /An/ @Inum@ /may never feed a chunk with the EOF flag set to/+--    /it's target/ 'Iter'. Instead, upon receiving EOF, the @Inum@+--    should simply return the state of the inner 'Iter' (this is how+--    \"popping\" the iteratee back out works--If the @Inum@ passed+--    the EOF through to the 'Iter', the 'Iter' would stop requesting+--    more input and could not be handed off to a new @Inum@).+--+-- 2. /An/ @Inum@ /must always return the state of its target/ 'Iter'.+--    This is true even when the @Inum@ fails, and is why the 'Fail'+--    state contains a @'Maybe' a@ field.+--+-- In addition to returning when it receives an EOF or fails, an+-- @Inum@ should return when the target 'Iter' returns a result or+-- fails.  An @Inum@ may also unilaterally return the state of the+-- iteratee at any earlier point, for instance if it has reached some+-- logical message boundary (e.g., many protocols finish processing+-- headers upon reading a blank line).+--+-- @Inum@s are generally constructed with one of the 'mkInum' or+-- '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.+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+-- @()@--i.e., @'Inum' () t m a@--so that there is no meaningful input+-- data to transcode.  Such an enumerator is called an+-- /outer enumerator/, because it must produce the data it feeds to+-- 'Iter's by either executing actions in monad @m@, or from its own+-- internal pure state (as for 'enumPure').+--+-- As with 'Inum's, an @Onum@ should under no circumstances ever feed+-- a chunk with the EOF bit set to its 'Iter' argument.  When the+-- @Onum@ runs out of data, it must simply return the current state of+-- the 'Iter'.  This way more data from another source can still be+-- fed to the iteratee, as happens when enumerators are concatenated+-- with the 'cat' function.+--+-- @Onum@s should generally be constructed using the 'mkInum' or+-- 'mkInumM' function, just like 'Inum's, the only difference being+-- that for an @Onum@ the input type is @()@, so executing 'Iter's to+-- consume input will be of little use.+type Onum t m a = Inum () t m a++-- Concatenation and fusing functions++-- | Run an 'Onum' on an 'Iter'.  This is the main way of actually+-- executing IO with 'Iter's.  @|$@ is a type-restricted version of+-- the following code, in which @inum@ must be an 'Onum':+--+-- @+--  inum |$ iter = 'run' (inum .| iter)+--  infixr 2 |$+-- @+(|$) :: (ChunkData t, Monad m) => Onum t m a -> Iter t m a -> m a+(|$) inum iter = run (inum .| iter)+infixr 2 |$++-- | @.|$@ is a variant of '|$' that allows you to apply an 'Onum'+-- from within an 'Iter' monad.  This is often useful in conjuction+-- with 'enumPure', if you want to parse at some coarse-granularity+-- (such as lines), and then re-parse the contents of some+-- coarser-grained parse unit.  For example:+--+-- >     rawcommand <- lineI+-- >     command <- enumPure rawcommand .|$ parseCommandI+-- >     return Request { cmd = command, rawcmd = rawcommand }+--+-- @.|$@ has the same fixity as @|$@, namely:+--+-- > infixr 2 .|$+--+-- Note the important distinction between @(.|$)@ and @('.|')@.+-- @(.|$)@ runs an 'Onum' and does not touch the current input, while+-- ('.|') pipes the current input through an 'Inum'.  For instance, to+-- send the contents of a file to standard output (regardless of the+-- current input), you must say @'enumFile' \".signature\" .|$+-- 'stdoutI'@.  But to take the current input, compress it, and send+-- the result to standard output, you must use '.|', as in @'inumGzip'+-- '.|' 'stdoutI'@.+--+-- As suggested by the types, @enum .|$ iter@ is sort of equivalent to+-- @'lift' (enum |$ iter)@, except that the latter will call 'throw'+-- on failures, causing language-level exceptions that cannot be+-- caught within the outer 'Iter'.  Thus, it is better to use @.|$@+-- than @'lift' (... '|$' ...)@, though in the less general case of+-- the IO monad, @enum .|$ iter@ is equivalent to @'liftIO' (enum '|$'+-- iter)@ as illustrated by the following examples:+--+-- > -- Catches exception, because .|$ propagates failure through the outer+-- > -- Iter Monad, where it can still be caught.+-- > apply1 :: IO String+-- > apply1 = enumPure "test1" |$ iter `catchI` handler+-- >     where+-- >       iter = enumPure "test2" .|$ fail "error"+-- >       handler (SomeException _) _ = return "caught error"+-- > +-- > -- Does not catch error.  |$ turns the Iter failure into a language-+-- > -- level exception, which can only be caught in the IO Monad.+-- > apply2 :: IO String+-- > apply2 = enumPure "test1" |$ iter `catchI` handler+-- >     where+-- >       iter = lift (enumPure "test2" |$ fail "error")+-- >       handler (SomeException _) _ = return "caught error"+-- > +-- > -- Catches the exception, because liftIO uses the IO catch function to+-- > -- turn language-level exceptions into monadic Iter failures.  (By+-- > -- contrast, lift works in any Monad, so cannot do this in apply2.)+-- > -- This example illustrates how liftIO is not equivalent to lift.+-- > apply3 :: IO String+-- > apply3 = enumPure "test1" |$ iter `catchI` handler+-- >     where+-- >       iter = liftIO (enumPure "test2" |$ fail "error")+-- >       handler (SomeException _) _ = return "caught error"+(.|$) :: (ChunkData tIn, ChunkData tOut, Monad m) =>+         Onum tOut m a -> Iter tOut m a -> Iter tIn m a+(.|$) enum iter = runI (enum .| iter)+infixr 2 .|$++-- | Concatenate the outputs of two enumerators.  For example,+-- @'enumFile' \"file1\" \`cat\` 'enumFile' \"file2\"@ produces an+-- 'Onum' that outputs the concatenation of files \"file1\" and+-- \"file2\".  Unless the first 'Inum' fails, @cat@ always invokes the+-- second 'Inum', as the second 'Inum' may have monadic side-effects+-- that must be executed even when the 'Iter' has already finished.+-- See 'lcat' if you want to stop when the 'Iter' no longer requires+-- input.  If you want to continue executing even in the event of an+-- 'InumFail' condition, you can wrap the first 'Inum' with+-- 'inumCatch' and invoke 'resumeI' from within the exception handler.+--+-- @cat@ (and 'lcat', described below) are useful in right folds.+-- Say, for instance, that @files@ is a list of files you wish to+-- concatenate.  You can use a construct such as:+--+-- @+--  catFiles :: ('MonadIO' m) => ['FilePath'] -> 'Onum' 'L.ByteString' m a+--  catFiles files = 'foldr' ('cat' . 'enumFile') 'inumNull' files+-- @+--+-- Note the use of 'inumNull' as the starting value for 'foldr'.  This+-- is not to be confused with 'inumNop'.  'inumNull' acts as a no-op+-- for concatentation, producing no output analogously to+-- @\/dev\/null@.  By contrast 'inumNop' is the no-op for fusing (see+-- '|.' and '.|' below) because it passes all data through untouched.+--+-- @cat@ has fixity:+--+-- > infixr 3 `cat`+cat :: (ChunkData tIn, ChunkData tOut, Monad m) =>+       Inum tIn tOut m a      -- ^+    -> Inum tIn tOut m a+    -> Inum tIn tOut m a+cat a b iter = tryRI (runInum a iter) >>= either reRunIter (b . reRunIter)+-- Note this was carefully constructed to preserve the return value in+-- errors.  Something like:  cat a b iter = a iter >>= b . reRunIter+-- would turn a @('Fail' e ('Just' r) c)@ result from @a@ into+-- @('Fail' e 'Nothing' c)@; since the input and output types of >>=+-- do not have to be the same, >>= must convert error results to+-- 'Nothing'.+infixr 3 `cat`++-- | Lazy cat.  Like 'cat', except that it does not run the second+-- 'Inum' if the 'Iter' is no longer active after completion of the+-- first 'Inum'.  Also has fixity @infixr 3 \`lcat\`@.+lcat :: (ChunkData tIn, ChunkData tOut, Monad m) =>+        Inum tIn tOut m a      -- ^+     -> Inum tIn tOut m a+     -> Inum tIn tOut m a+lcat a b iter = tryRI (runInum a iter) >>= either reRunIter check+    where check r = if isIterActive r then b $ reRunIter r else return r+infixr 3 `lcat`++-- | Transforms the result of an 'Inum' into the result of the 'Iter'+-- that it contains.  Used by '|.' and '.|' to collapse their result+-- types.+--+-- Note that because the input type if the inner 'Iter', @tMid@, gets+-- squeezed out of the return type, @joinR@ will feed an EOF to the+-- inner 'Iter' if it is still active.  This is what ensures that+-- active 'Iter's end up seeing an EOF, even though 'Inum's themselves+-- are never supposed to feed an EOF to the underlying 'Iter'.  All+-- 'Iter's in right-hand arguments of '.|' and '|.' get fed an EOF by+-- @joinR@ (if they don't finish on their own), while the outermost+-- 'Inum' is fed an iter by the 'run' function (or by '|$' which+-- invokes 'run' internally).+joinR :: (ChunkData tIn, ChunkData tMid, Monad m) =>+         IterR tIn m (IterR tMid m a)+      -> IterR tIn m a+joinR (Done i c)          = runIterR (runR i) c+joinR (Fail e Nothing c)  = Fail e Nothing c+--+-- Note that 'runR' in the following function is serving two purposes,+-- one of them subtle.  The obvious purpose is to preserve the state+-- of the non-failed target 'Iter' when an 'Inum' has failed.+-- However, a subtler, more important purpose is to guarantee that all+-- (non-failed) 'Iter's eventually receive EOF even when 'Inum's fail.+-- This is critical for things like EOF transmission and file+-- descriptor closing, and is how functions such as 'pairFinalizer'+-- can make sense.+joinR (Fail e (Just i) c) = flip onDoneR (runR i) $ \r ->+                            case r of+                              Done a _    -> Fail e (Just a) c+                              Fail e' a _ -> Fail e' a c+                              _ -> error "joinR"+joinR _                   = error "joinR: not done"++-- | Left-associative pipe operator.  Fuses two 'Inum's when the+-- output type of the first 'Inum' is the same as the input type of+-- the second.  More specifically, if @inum1@ transcodes type @tIn@ to+-- @tOut@ and @inum2@ transcodes @tOut@ to @tOut2@, then @inum1+-- |. inum2@ produces a new 'Inum' that transcodes from @tIn@ to+-- @tOut2@.+--+-- Typically types @i@ and @iR@ are @'Iter' tOut2 m a@ and @'IterR'+-- tOut2 m a@, respectively, in which case the second argument and+-- result of @|.@ are also 'Inum's.+--+-- This function is equivalent to:+--+-- @+--  outer |. inner = \\iter -> outer '.|' inner iter+--  infixl 4 |.+-- @+--+-- But if you like point-free notation, think of it as @outer |. inner+-- = (outer '.|') . inner@, or better yet @(|.) = (.)  . ('.|')@.+(|.) :: (ChunkData tIn, ChunkData tOut, Monad m) =>+        Inum tIn tOut m iR      -- ^+     -> (i -> Iter tOut m iR)+     -> (i -> Iter tIn m iR)+(|.) outer inner = \iter -> onDone joinR $ outer $ inner iter+infixl 4 |.++-- | Right-associative pipe operator.  Fuses an 'Inum' that transcodes+-- @tIn@ to @tOut@ with an 'Iter' taking input type @tOut@ to produce+-- an 'Iter' taking input type @tIn@.  If the 'Iter' is still active+-- when the 'Inum' terminates (either normally or through an+-- exception), then @.|@ sends it an EOF.+--+--  Has fixity:+--+-- > infixr 4 .|+(.|) :: (ChunkData tIn, ChunkData tOut, Monad m) =>+         Inum tIn tOut m a     -- ^+      -> Iter tOut m a+      -> Iter tIn m a+(.|) inum iter = onDone joinR $ inum iter+infixr 4 .|++--+-- Exception functions+--++-- | Catches errors thrown by an 'Inum', or a set of fused 'Inum's.+-- Note that only errors in 'Inum's that are lexically within the+-- scope of the argument to 'inumCatch' will be caught.  For example:+--+-- > inumBad :: (ChunkData t, Monad m) => Inum t t m a+-- > inumBad = mkInum $ fail "inumBad"+-- > +-- > skipError :: (ChunkData tIn, MonadIO m) =>+-- >              SomeException+-- >           -> IterR tIn m (IterR tOut m a)+-- >           -> Iter tIn m (IterR tOut m a)+-- > skipError e iter = do+-- >   liftIO $ hPutStrLn stderr $ "skipping error: " ++ show e+-- >   resumeI iter+-- >+-- > -- Throws an exception, because inumBad was fused outside the argument+-- > -- to inumCatch.+-- > test1 :: IO ()+-- > test1 = inumCatch (enumPure "test") skipError |. inumBad |$ nullI+-- > +-- > -- Does not throw an exception, because inumBad fused within the+-- > -- argument to inumCatch.+-- > test2 :: IO ()+-- > test2 = inumCatch (enumPure "test" |. inumBad) skipError |$ nullI+-- > +-- > -- Again no exception, because inumCatch is wrapped around inumBad.+-- > test3 :: IO ()+-- > test3 = enumPure "test" |. inumCatch inumBad skipError |$ nullI+--+-- Note that @\`inumCatch\`@ has the default infix precedence (@infixl+-- 9 \`inumcatch\`@), which binds more tightly than any concatenation+-- or fusing operators.+--+-- As noted for 'catchI', exception handlers receive both the+-- exception thrown and the failed 'IterR'.  Particularly in the case+-- of @inumCatch@, it is important to re-throw exceptions by+-- re-executing the failed 'Iter' with 'reRunIter', not passing the+-- exception itself to 'throwI'.  That way, if the exception is+-- re-caught, 'resumeI' will continue to work properly.  For example,+-- to copy two files to standard output and ignore file not found+-- errors but re-throw any other kind of error, you could use the+-- following:+--+-- @+--  resumeTest :: IO ()+--  resumeTest = doFile \"file1\" ``cat`` doFile \"file2\" |$ 'stdoutI'+--      where+--        doFile path = inumCatch (`enumFile'` path) $ \\err r ->+--                        if 'isDoesNotExistError' err+--                          then 'verboseResumeI' r+--                          else 'reRunIter' r+-- @+--+inumCatch :: (Exception e, ChunkData tIn, Monad m) =>+              Inum tIn tOut m a+           -- ^ 'Inum' that might throw an exception+           -> (e -> IterR tIn m (IterR tOut m a) -> Iter tIn m (IterR tOut m a))+           -- ^ Exception handler+           -> Inum tIn tOut m a+inumCatch enum handler iter = catchI (enum iter) check+    where check e r@(Fail _ (Just _) _) = handler e r+          check _ r                     = reRunIter r++-- | Execute some cleanup action when an 'Inum' finishes.+inumFinally :: (ChunkData tIn, Monad m) =>+               Inum tIn tOut m a -> Iter tIn m b -> Inum tIn tOut m a+inumFinally inum cleanup iter = inum iter `finallyI` cleanup++-- | Execute some cleanup action if an 'Inum' fails.  Does not execute+-- the action if the 'Iter' (or some inner 'Inum') fails.  Has the+-- same scoping rules as 'inumCatch'.+inumOnException :: (ChunkData tIn, Monad m) =>+               Inum tIn tOut m a -> Iter tIn m b -> Inum tIn tOut m a+inumOnException inum cleanup iter = inum iter `onExceptionI` cleanup++-- | Used in an exception handler, after an 'Inum' failure, to resume+-- processing of the 'Iter' by the next enumerator in a 'cat'ed+-- series.  See 'inumCatch' for an example.+resumeI :: (ChunkData tIn, Monad m) =>+           IterR tIn m (IterR tOut m a) -> Iter tIn m (IterR tOut m a)+resumeI (Fail _ (Just a) _) = return a+resumeI _                   = error "resumeI: not an Inum failure"++-- | Like 'resumeI', but if the 'Iter' is resumable, also prints an+-- error message to standard error before resuming.+verboseResumeI :: (ChunkData tIn, MonadIO m) =>+                  IterR tIn m (IterR tOut m a) -> Iter tIn m (IterR tOut m a)+verboseResumeI (Fail e (Just a) _) = do+  liftIO $ do prog <- liftIO getProgName+              hPutStrLn stderr $ prog ++ ": " ++ show e+  return a+verboseResumeI _ = error "verboseResumeI: not an Inum failure"++--+-- Control handlers+--++-- | A @ResidHandler@ specifies how to handle residual data in an+-- 'Inum'.  Typically, when an 'Inum' finishes executing, there are+-- two kinds of residual data.  First, the 'Inum' itself (in its role+-- as an iteratee) may have left some unconsumed data.  Second, the+-- target 'Iter' being fed by the 'Inum' may have some resitual data,+-- and this data may be of a different type.  A @ResidHandler@ allows+-- this residual data to be adjusted by untranslating the residual+-- data of the target 'Iter' and sticking the result back into the+-- `Inum`'s residual data.+--+-- The two most common @ResidHandler@s are 'pullupResid' (to pull the+-- target `Iter`'s residual data back up to the 'Inum' as is), and+-- 'id' (to do no adjustment of residual data).+--+-- @ResidHandler@s are used by the 'mkInumC' function, and by the+-- 'passCtl' 'CtlHandler'.+type ResidHandler tIn tOut = (tIn, tOut) -> (tIn, tOut)++withResidHandler :: ResidHandler tIn tOut+                 -> Chunk tOut+                 -> (Chunk tOut -> Iter tIn mIn a)+                 -> Iter tIn mIn a+withResidHandler adjust (Chunk tOut0 eofOut) cont =+    Iter $ \(Chunk tIn0 eofIn) ->+    case adjust (tIn0, tOut0) of+      (tIn, tOut) -> runIter (cont $ Chunk tOut eofOut) $ Chunk tIn eofIn++-- | A control handler maps control requests to 'IterR' results.+-- Generally the type parameter @m1@ is @'Iter' t' m@.+type CtlHandler m1 t m a = CtlArg t m a -> m1 (IterR t m a)++-- | Reject all control requests.+noCtl :: (Monad m1) => CtlHandler m1 t m a+noCtl (CtlArg _ n c) = return $ runIter (n CtlUnsupp) c++-- | Pass all control requests through to the enclosing 'Iter' monad.+-- The 'ResidHandler' argument says how to adjust residual data, in+-- case some enclosing 'CtlHandler' decides to flush pending input+-- data, it is advisable to un-translate any data in the output type+-- @tOut@ back to the input type @tIn@.+passCtl :: (Monad mIn) =>+           ResidHandler tIn tOut+        -> CtlHandler (Iter tIn mIn) tOut m a+passCtl adj (CtlArg a n c0) = withResidHandler adj c0 runn+    where runn c = do mcr <- safeCtlI a+                      return $ runIter (n mcr) c++-- | Create a 'CtlHandler' given a function of a particular control+-- argument type and a fallback 'CtlHandler' to run if the argument+-- type does not match.  @consCtl@ is used to chain handlers, with the+-- rightmost handler being either 'noCtl' or 'passCtl'.+--+-- For example, to create a control handler that implements seek on+-- @'SeekC'@ requests, returns the size of the file on @'SizeC'@+-- requests, and passes everything else out to the enclosing+-- enumerator (if any), you could use the following:+--+-- @+-- fileCtl :: (ChunkData t, MonadIO m) => Handle -> CtlHandler (Iter () m) t m a+-- fileCtl h = ('mkFlushCtl' $ \(SeekC mode pos) -> liftIO (hSeek h mode pos))+--             \`consCtl\` ('mkCtl' $ \SizeC -> liftIO (hFileSize h))+--             \`consCtl\` 'passCtl' 'id'+-- @+--+-- Has fixity:+--+-- > infixr 9 `consCtl`+consCtl :: (CtlCmd carg cres, ChunkData tIn, Monad mIn) =>+           (carg -> (cres -> Iter t m a) -> Chunk t+                 -> Iter tIn mIn (IterR t m a))+        -> 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+                    `catchI` \e _ -> return $ runIter (n $ CtlFail e) c+infixr 9 `consCtl`++-- | Make a control function suitable for use as the first argument to+-- 'consCtl'.+mkCtl :: (CtlCmd carg cres, Monad m1) =>+         (carg -> Iter t1 m1 cres)+      -> carg -> (cres -> Iter t m a) -> Chunk t -> Iter t1 m1 (IterR t m a)+mkCtl f a n c = do cres <- f a; return $ runIter (n cres) c++-- | Like 'mkCtl', except that it flushes all input and clears the EOF+-- flag in both 'Iter' monads after executing the control function.+mkFlushCtl :: (CtlCmd carg cres, Monad mIn, ChunkData tIn, ChunkData t) =>+              (carg -> Iter tIn mIn cres)+           -> carg -> (cres -> Iter t m a) -> Chunk t+           -> Iter tIn mIn (IterR t m a)+mkFlushCtl f a n _ = do cres <- onDone (flip setResid mempty) $ f a+                        return $ runIter (n cres) mempty+  +--+-- Basic tools+--++-- $mkInumIntro+--+-- The 'mkInum' function allows you to create stateless 'Inum's out of+-- simple transcoding 'Iter's.  As an example, suppose you are+-- processing a list of @L.ByteString@s representing packets, and want+-- to concatenate them all into one continuous stream of bytes.  You+-- could implement an 'Inum' called @inumConcat@ to do this as+-- follows:+--+-- #mkInumExample#+--+-- @+--iterConcat :: (Monad m) => 'Iter' [L.ByteString] m L.ByteString+--iterConcat = L.concat ``liftM`` 'dataI'+--+--inumConcat :: (Monad m) => 'Inum' [L.ByteString] L.ByteString m a+--inumConcat = 'mkInum' iterConcat+-- @+--++-- | Like 'runIterMC', but only for 'IterM'--may return 'IterC'.+runIterM :: (Monad m, MonadTrans mt, Monad (mt m)) =>+            Iter t m a -> Chunk t -> mt m (IterR t m a)+runIterM iter c = check $ runIter iter c+    where check (IterM m) = lift m >>= check+          check r         = return r++runIterRMC :: (Monad m) =>+              CtlHandler (Iter tIn m) tOut m a+           -> IterR tOut m a -> Iter tIn m (IterR tOut m a)+runIterRMC ch = check+    where check (IterM m)  = lift m >>= check+          check (IterC ca) = ch ca >>= check+          check r          = return r++-- | Run an 'Iter' just like 'runIter', but then keep stepping the+-- result for as long as it is in the 'IterM' or 'IterC' state (using+-- the supplied 'CtlHandler' for 'IterC' states).  'Inum's should+-- generally use this function or 'runIterM' in preference to+-- 'runIter', as it is convenient if 'Inum's avoid ever returning+-- 'IterR's in the 'IterM' state.+runIterMC :: (Monad m) =>+             CtlHandler (Iter tIn m) tOut m a+          -> Iter tOut m a -> Chunk tOut -> Iter tIn m (IterR tOut m a)+runIterMC ch iter c = runIterRMC ch $ runIter iter c++-- | Takes an 'Inum' that might return 'IterR's in the 'IterM' state+-- (which is considered impolite--see 'runIterMC') and transforms it+-- into an 'Inum' that never returns 'IterR's in the 'IterM' state.+runInum :: (ChunkData tIn, Monad m) =>+           Inum tIn tOut m a -> Inum tIn tOut m a+runInum inum = onDone check . inum+    where+      check (Done (IterM m) c) = IterM $ m >>= \r -> return $ check $ Done r c+      check r = r++-- | 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.+--+-- @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+-- handler for control requests.  For example, to pass up control+-- requests and ensure no residual data is lost when the 'Inum' is+-- fused to an 'Iter', the @inumConcat@ function given previously for+-- 'mkInum' at <#mkInumExample> could be re-written:+--+-- > inumConcat :: (Monad m) => Inum [L.ByteString] L.ByteString m a+-- > inumConcat = mkInumC reList (passCtl reList) iterConcat+-- >     where reList (a, b) = (b:a, mempty)+mkInumC :: (ChunkData tIn, ChunkData tOut, Monad m) =>+           ResidHandler tIn tOut+        -- ^ Adjust residual data (use 'id' for no adjustment)+        -> CtlHandler (Iter tIn m) tOut m a+        -- ^ Handle control requests (use 'noCtl' or 'passCtl' if+        -- 'Inum' shouldn't implement any specific control functions).+        -> Iter tIn m tOut+        -- ^ Generate transcoded data chunks+        -> Inum tIn tOut m a+mkInumC adj ch codec iter0 = doIter iter0+    where+      doIter iter = tryEOFI codec >>= maybe (return $ IterF iter) (doInput iter)+      doInput iter input = do+        r <- runIterMC ch iter (Chunk input False)+        case r of+          (IterF i) | not (null input) -> doIter i+          _ | isIterActive r -> return r+          _ -> withResidHandler adj (getResid r) $ return . setResid r++-- | Create an 'Inum' based on an 'Iter' that transcodes the input to+-- the output type.  This is a simplified version of 'mkInumC' that+-- rejects all control requests and does not adjust residual data.+--+-- > mkInum = mkInumC id noCtl+mkInum :: (ChunkData tIn, ChunkData tOut, Monad m) =>+          Iter tIn m tOut -> Inum tIn tOut m a+mkInum = mkInumC id noCtl++-- | A simplified version of 'mkInum' that passes all control requests+-- to enclosing enumerators.  It requires a 'ResidHandler' to describe+-- how to adjust residual data.  (E.g., use 'pullupResid' when @tIn@+-- and @tOut@ are the same type.)+--+-- > mkInumP adj = mkInumC adj (passCtl adj)+mkInumP :: (ChunkData tIn, ChunkData tOut, Monad m) =>+           ResidHandler tIn tOut -> Iter tIn m tOut -> Inum tIn tOut m a+mkInumP adj = mkInumC adj (passCtl adj)++-- | @pullupResid (a, b) = (mappend a b, mempty)@.  See 'ResidHandler'.+pullupResid :: (ChunkData t) => (t, t) -> (t, t)+pullupResid (a, b) = (mappend a b, mempty)++-- | Bracket an 'Inum' with a start and end function, which can be+-- used to acquire and release a resource, must like the IO monad's+-- @'bracket'@ function.  For example:+--+-- > enumFile :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+-- >             FilePath -> Onum t m a+-- > enumFile path = inumBracket (liftIO $ openBinaryFile path ReadMode)+-- >                             (liftIO . hClose)+-- >                             enumHandle+inumBracket :: (ChunkData tIn, Monad m) =>+               Iter tIn m b+            -- ^ Computation to run first+            -> (b -> Iter tIn m c)+            -- ^ Computation to run last+            -> (b -> Inum tIn tOut m a)+            -- ^ Inum to bracket+            -> Inum tIn tOut m a+inumBracket start end inum iter = tryFI start >>= check+    where check (Left e)  = Iter $ Fail e (Just $ IterF iter) . Just+          check (Right b) = inum b iter `finallyI` end b++--+-- Basic Inums+--++-- | @inumNop@ passes all data through to the underlying 'Iter'.  It+-- acts as a no-op when fused to other 'Inum's with '|.' or when fused+-- to 'Iter's with '.|'.+--+-- @inumNop@ is particularly useful for conditionally fusing 'Inum's+-- together.  Even though most 'Inum's are polymorphic in the return+-- type, this library does not use the Rank2Types extension, which+-- means any given 'Inum' must have a specific return type.  Here is+-- an example of incorrect code:+--+-- @+-- let enum = if debug then base_enum '|.' 'inumStderr' else base_enum -- Error+-- @+--+-- This doesn't work because @base_enum@ cannot have the same type as+-- @(base_enum |. inumStderr)@.  Instead, you can use the following:+--+-- @+-- let enum = base_enum '|.' if debug then 'inumStderr' else inumNop+-- @+inumNop :: (ChunkData t, Monad m) => Inum t t m a+inumNop = mkInumP pullupResid dataI++-- | @inumNull@ feeds empty data to the underlying 'Iter'.  It pretty+-- much acts as a no-op when concatenated to other 'Inum's with 'cat'+-- or 'lcat'.+--+-- There may be cases where @inumNull@ is required to avoid deadlock.+-- In an expression such as @enum '|$' iter@, if @enum@ immediately+-- blocks waiting for some event, and @iter@ immediately starts out+-- triggering that event before reading any input, then to break the+-- deadlock you can re-write the code as @cat inumNull enum '|$'+-- iter@.+inumNull :: (ChunkData tOut, Monad m) => Inum tIn tOut m a+inumNull = inumPure mempty++-- | Feed pure data to an 'Iter'.+inumPure :: (Monad m) => tOut -> Inum tIn tOut m a+inumPure t iter = runIterM iter $ chunk t++-- | Type-restricted version of 'inumPure'.+enumPure :: (Monad m) => tOut -> Onum tOut m a+enumPure = inumPure++-- | Repeat an 'Inum' until the input receives an EOF condition, the+-- 'Iter' no longer requires input, or the 'Iter' is in an unhandled+-- 'IterC' state (which presumably will continue to be unhandled by+-- the same 'Inum', so no point in executing it again).+inumRepeat :: (ChunkData tIn, Monad m) =>+              Inum tIn tOut m a -> Inum tIn tOut m a+inumRepeat inum iter0 = do+  er <- tryRI $ runInum inum iter0+  stop <- atEOFI+  case (stop, er) of+    (False, Right (IterF iter)) -> inumRepeat inum iter+    (_, Right r) -> return r+    (_, Left r) -> reRunIter r++--+-- Complex Inum creation+--++{- $mkInumMIntro++Complex 'Inum's that need state and non-trivial control flow can be+constructed using the 'mkInumM' function to produce an 'Inum' out of a+computation in the 'InumM' monad.  The 'InumM' monad implicitly keeps+track of the state of the 'Iter' to which the 'Inum' is feeding data,+which we call the \"target\" 'Iter'.++'InumM' is an 'Iter' monad, and so can consume input by invoking+ordinary 'Iter' actions.  However, to keep track of the state of the+target 'Iter', 'InumM' wraps its inner monadic type with an+'IterStateT' transformer.  Specifically, when creating an enumerator+of type @'Inum' tIn tOut m a@, the 'InumM' action is of a type like+@'Iter' tIn ('IterStateT' (InumState ...) m) ()@.  That means that to+execute actions of type @'Iter' tIn m a@ that are not polymorphic in+@m@, you have to transform them with the 'liftI' function.++Output can be fed to the target 'Iter' by means of the 'ifeed'+function.  As an example, here is another version of the @inumConcat@+function given previously for 'mkInum' at <#mkInumExample>:++@+inumConcat :: (Monad m) => 'Inum' [L.ByteString] L.ByteString m a+inumConcat = 'mkInumM' loop+    where loop = do+            'Chunk' t eof <- 'chunkI'+            done <- 'ifeed' $ L.concat t+            if not (eof || done)+              then loop+              else do resid <- 'ipopresid'+                      'ungetI' [resid]+@++There are several points to note about this function.  It reads data+in 'Chunk's using 'chunkI', rather than just inputting data with+'dataI'.  The choice of 'chunkI' rather than 'dataI' allows+@inumConcat@ to see the @eof@ flag and know when there is no more+input.  'chunkI' also avoids throwing an 'IterEOF' exception on end of+file, as 'dataI' would.  In contrast to 'mkInum', which gracefully+interprets 'IterEOF' exceptions as an exit request, 'mkInumM' by+default treats such exceptions as an 'Inum' failure.++As previously mentioned, data is fed to the target 'Iter', which here+is of type @'Iter' L.ByteString m a@, using 'ifeed'.  'ifeed' returns+a 'Bool' that is @'True'@ when the 'Iter' is no longer active.  This+brings us to another point--there is no implicit looping or+repetition.  We explicitly loop via a tail-recursive call to @loop@ so+long as the @eof@ flag is clear and 'ifeed' returned @'False'@+indicating the target 'Iter' has not finished.++What happens when @eof@ or @done@ is set?  One possibility is to do+nothing.  This is often correct.  Falling off the end of the 'InumM'+do-block causes the 'Inum' to return the current state of the 'Iter'.+However, it may be that the 'Inum' has been fused to the target+'Iter', in which case any left-over residual data fed to, but not+consumed by, the target 'Iter' will be discarded.  We may instead want+to put the data back onto the input stream.  The 'ipopresid' function+extracts any left-over data from the target 'Iter', while 'ungetI'+places data back in the input stream.  Since here the input stream is+a list of @L.ByteString@s, we have to place @resid@ in a list.  (After+doing this, the list element boundaries may be different, but all the+input bytes will be there.)  Note that the version of @inumConcat@+implemented with 'mkInum' at <#mkInumExample> does not have this+input-restoring feature.++The code above looks much clumsier than the version based on 'mkInum',+but several of these steps can be made implicit.  There is an+/AutoEOF/ flag, controlable with the 'setAutoEOF' function, that+causes 'IterEOF' exceptions to produce normal termination of the+'Inum', rather than failure (just as 'mkInum' handles such+exceptions).  Another flag, /AutoDone/, is controlable with the+'setAutoDone' function and causes the 'Inum' to exit immediately when+the underlying 'Iter' is no longer active (i.e., the 'ifeed' function+returns @'True'@).  Both of these flags are set at once by the+'mkInumAutoM' function, which yields the following simpler+implementation of @inumConcat@:++@+inumConcat = 'mkInumAutoM' $ do 'addCleanup' $ 'ipopresid' >>= 'ungetI' . (: [])+                              loop+    where loop = do+            t <- 'dataI'         -- AutoEOF flag will handle IterEOF err+            'ifeed' $ L.concat t -- AutoDone flag will catch True result+            loop+@++The 'addCleanup' function registers actions that should always be+executed when the 'Inum' finishes.  Here we use it to place residual+data from the target 'Iter' back into the `Inum`'s input stream.++Finally, there is a function 'irepeat' that automatically sets the+/AutoEOF/ and /AutoDone/ flags and then loops forever on an 'InumM'+computation.  Using 'irepeat' to simplify further, we have:++@+'inumConcat' = 'mkInumM' $ 'withCleanup' ('ipopresid' >>= 'ungetI' . (: [])) $+             'irepeat' $ 'dataI' >>= 'ifeed' . L.concat+@++'withCleanup', demonstrated here, is a variant of 'addCleanup' that+cleans up after a particular action, rather than at the end of the+`Inum`'s whole execution.  (At the outermost level, as used here,+`withCleanup`'s effects are identical to `addCleanup`'s.)++In addition to 'ifeed', the 'ipipe' function invokes a different+'Inum' from within the 'InumM' monad, piping its output directly to+the target 'Iter'.  As an example, consider an 'Inum' that processes a+mail message and appends a signature line, implemented as follows:++@+inumAddSig :: (Monad m) => 'Inum' L.ByteString L.ByteString m a+inumAddSig = 'mkInumM' $ do+  'ipipe' 'inumNop'+  'ifeed' $ L8.pack \"\\n--\\nSent from my Haskell interpreter.\\n\"+@++Here we start by using 'inumNop' to \"pipe\" all input to the target+'Iter' unmodified.  On reading an end of file, 'inumNop' returns, at+which point we use 'ifeed' to append our signature.++A similar function 'irun' runs an 'Onum' (or 'Inum' of a different+type) on the target 'Iter'.  For instance, to read the signature from+a file called @\".signature\"@, one could use:++@+inumAddSig :: ('MonadIO' m) => 'Inum' L.ByteString L.ByteString m a+inumAddSig = 'mkInumM' $ do+  'ipipe' 'inumNop'+  'irun' $ 'enumFile' \".signature\"+@++Of course, these examples are a bit contrived.  An even simpler+implementation is:++@+inumAddSig = 'inumNop' ``cat`` 'runI' . 'enumFile' \".signature\"+@++The @.@ between 'runI' and @'enumFile'@ is because 'Inum's are+functions from 'Iter's to 'IterR's; we want to apply 'runI' to the+result of applying @'enumFile' \".signature\"@ to an 'Iter'.  Spelled+out, the type of @'enumFile'@ is:++@+enumFile :: (MonadIO m, ChunkData t, ListLikeIO t e) =>+            FilePath+         -> 'Iter' t m a+         -> 'Iter' () m a ('IterR' t m a)+@++-}++-- | Internal data structure for the 'InumM' monad's state.+data InumState tIn tOut m a = InumState {+      insAutoEOF :: !Bool+    , insAutoDone :: !Bool+    , insCtl :: !(CtlHandler (Iter tIn m) tOut m a)+    , insIter :: !(IterR tOut m a)+    , insCleanup :: !(InumM tIn tOut m a ())+    , insCleaning :: !Bool+    }++defaultInumState :: (ChunkData tIn, Monad m) => InumState tIn tOut m a+defaultInumState = InumState {+                     insAutoEOF = False+                   , insAutoDone = False+                   , insCtl = noCtl+                   , insIter = IterF $ Iter $ const $ error "insIter"+                   , insCleanup = return ()+                   , insCleaning = False+                   }++-- | A monad in which to define the actions of an @'Inum' tIn tOut m+-- a@.  Note @InumM tIn tOut m a@ is a 'Monad' of kind @* -> *@, where+-- @a@ is the (almost always parametric) return type of the 'Inum'.  A+-- fifth type argument is required for monadic computations of kind+-- @*@, e.g.:+--+-- > seven :: InumM tIn tOut m a Int+-- > seven = return 7+--+-- Another important thing to note about the 'InumM' monad, as+-- described in the documentation for 'mkInumM', is that you must call+-- @'lift'@ twice to execute actions in monad @m@, and you must use+-- the 'liftI' function to execute actions in monad @'Iter' t m a@.+type InumM tIn tOut m a = Iter tIn (IterStateT (InumState tIn tOut m a) m)++-- | Set the control handler an 'Inum' should use from within an+-- 'InumM' computation.  (The default is 'noCtl'.)+setCtlHandler :: (ChunkData tIn, Monad m) =>+                 CtlHandler (Iter tIn m) tOut m a+              -> InumM tIn tOut m a ()+setCtlHandler ch = imodify $ \s -> s { insCtl = ch }++-- | Set the /AutoEOF/ flag within an 'InumM' computation.  If this+-- flag is 'True', handle 'IterEOF' exceptions like a normal but+-- immediate termination of the 'Inum'.  If this flag is @'False'@+-- (the default), then 'IterEOF' exceptions must be manually caught or+-- they will terminate the thread.+setAutoEOF :: (ChunkData tIn, Monad m) => Bool -> InumM tIn tOut m a ()+setAutoEOF val = imodify $ \s -> s { insAutoEOF = val }++-- | Set the /AutoDone/ flag within an 'InumM' computation.  When+-- @'True'@, the 'Inum' will immediately terminate as soon as the+-- 'Iter' it is feeding enters a non-active state (i.e., 'Done' or a+-- failure state).  If this flag is @'False'@ (the default), the+-- 'InumM' computation will need to monitor the results of the+-- 'ifeed', 'ipipe', and 'irun' functions to ensure the 'Inum'+-- terminates when one of these functions returns @'False'@.+setAutoDone :: (ChunkData tIn, Monad m) => Bool -> InumM tIn tOut m a ()+setAutoDone val = imodify $ \s -> s { insAutoDone = val }++-- | Like imodify, but throws an error if the insCleaning flag is set.+ncmodify :: (ChunkData tIn, Monad m) =>+            (InumState tIn tOut m a -> InumState tIn tOut m a)+            -> InumM tIn tOut m a ()+ncmodify fn = imodify $ \s -> if insCleaning s+                              then error "illegal call within Cleanup function"+                              else fn s++-- | Add a cleanup action to be executed when the 'Inum' finishes, or,+-- if used in conjunction with the 'withCleanup' function, when the+-- innermost enclosing 'withCleanup' action finishes.+addCleanup :: (ChunkData tIn, Monad m) =>+              InumM tIn tOut m a () -> InumM tIn tOut m a ()+addCleanup clean = ncmodify $ \s -> s { insCleanup = clean >> insCleanup s }++-- | Run an 'InumM' with some cleanup action in effect.  The cleanup+-- action specified will be executed when the main action returns,+-- whether normally, through an exception, because of the /AutoDone/+-- or /AutoEOF/ flags, or because 'idone' is invoked.+--+-- Note @withCleanup@ also defines the scope of actions added by the+-- 'addCleanup' function.  In other words, given a call such as+-- @withCleanup cleaner1 main@, if @main@ invokes @'addCleanup'+-- cleaner2@, then both @cleaner1@ and @cleaner2@ will be executed+-- upon @main@'s return, even if the overall 'Inum' has not finished+-- yet.+withCleanup :: (ChunkData tIn, Monad m) =>+              InumM tIn tOut m a () -- ^ Cleanup action+           -> InumM tIn tOut m a b  -- ^ Main action to execute+           -> InumM tIn tOut m a b+withCleanup clean action = do+  old <- igets insCleanup+  ncmodify $ \s -> s { insCleanup = clean }+  action `finallyI` do+    newclean <- igets insCleanup+    imodify $ \s -> s { insCleanup = old }+    newclean++-- | Convert an 'InumM' computation into an 'Inum', given some+-- @'InumState'@ to run on.+runInumM :: (ChunkData tIn, ChunkData tOut, Monad m) =>+            InumM tIn tOut m a b+         -- ^ Monadic computation defining the 'Inum'.+         -> InumState tIn tOut m a+         -- ^ State to run on+         -> Iter tIn m (IterR tOut m a)+runInumM inumm s0 = do+  (err1, s1) <- getErr =<< runIterStateT inumm s0+  (err2, s2) <- getErr =<< runIterStateT (insCleanup s1)+                                 s1 { insAutoDone = False, insCleaning = True }+  let r = insIter s2+  Iter $ maybe (Done r) (\e -> Fail e (Just r) . Just) $ mplus err2 err1+    where+      getErr (Fail (IterEOFErr _) _ _, s) | insAutoEOF s = return (Nothing, s)+      getErr (Fail e _ _, s)                             = return (Just e, s)+      getErr (_, s)                                      = return (Nothing, s)++-- | A variant of 'mkInumM' that sets /AutoEOF/ and /AutoDone/ to+-- 'True' by default.  (Equivalent to calling @'setAutoEOF' 'True' >>+-- 'setAutoDone' 'True'@ as the first thing inside 'mkInumM'.)+mkInumAutoM :: (ChunkData tIn, ChunkData tOut, Monad m) =>+               InumM tIn tOut m a b -> Inum tIn tOut m a+mkInumAutoM inumm iter0 =+    runInumM inumm defaultInumState { insIter = IterF iter0+                                    , insAutoEOF = True+                                    , insAutoDone = True+                                    }+++-- | Build an 'Inum' out of an 'InumM' computation.  If you run+-- 'mkInumM' inside the @'Iter' tIn m@ monad (i.e., to create an+-- enumerator of type @'Inum' tIn tOut m a@), then the 'InumM'+-- computation will be in a Monad of type @'Iter' t tm@ where @tm@ is+-- a transformed version of @m@.  This has the following two+-- consequences:+--+--  - If you wish to execute actions in monad @m@ from within your+--    'InumM' computation, you will have to apply @'lift'@ twice (as+--    in @'lift' $ 'lift' action_in_m@) rather than just once.+--+--  - If you need to execute actions in the @'Iter' t m@ monad, you+--    will have to lift them with the 'liftI' function.+--+-- The 'InumM' computation you construct can feed output of type+-- @tOut@ to the target 'Iter' (which is implicitly contained in the+-- monad state), using the 'ifeed', 'ipipe', and 'irun' functions.+mkInumM :: (ChunkData tIn, ChunkData tOut, Monad m) =>+           InumM tIn tOut m a b -> Inum tIn tOut m a+mkInumM inumm iter0 =+    runInumM inumm defaultInumState { insIter = IterF iter0 }++-- | Used from within the 'InumM' monad to feed data to the target+-- 'Iter'.  Returns @'False'@ if the target 'Iter' is still active and+-- @'True'@ if the iter has finished and the 'Inum' should also+-- return.  (If the @autoDone@ flag is @'True'@, then @ifeed@,+-- @ipipe@, and @irun@ will never actually return @'True'@, but+-- instead just immediately run cleanup functions and exit the+-- 'Inum' when the target 'Iter' stops being active.)+ifeed :: (ChunkData tIn, ChunkData tOut, Monad m) =>+         tOut -> InumM tIn tOut m a Bool+ifeed = ipipe . inumPure++-- | A variant of 'ifeed' that throws an exception of type 'IterEOF'+-- if the data being fed is 'null'.  Convenient when reading input+-- with a function (such as "Data.ListLike"'s @hget@) that returns 0+-- bytes instead of throwing an EOF exception to indicate end of file.+-- For instance, the main loop of @'enumFile'@ could be implemented+-- as:+--+-- @+--  'irepeat' $ 'liftIO' ('LL.hGet' h 'defaultChunkSize') >>= 'ifeed1'+-- @+ifeed1 :: (ChunkData tIn, ChunkData tOut, Monad m) =>+          tOut -> InumM tIn tOut m a Bool+ifeed1 dat = if null dat then throwEOFI "ifeed1" else ifeed dat++-- | Apply another 'Inum' to the target 'Iter' from within the 'InumM'+-- monad.  As with 'ifeed', returns @'True'@ when the 'Iter' is+-- finished.+--+-- Note that the applied 'Inum' must handle all control requests.  (In+-- other words, ones it passes on are not caught by whatever handler+-- is installed by 'setCtlHandler', but if the 'Inum' returns the+-- 'IterR' in the 'IterC' state, as 'inumPure' does, then requests+-- will be handled.)+ipipe :: (ChunkData tIn, ChunkData tOut, Monad m) =>+         Inum tIn tOut m a -> InumM tIn tOut m a Bool+ipipe inum = do+  s <- iget+  r <- tryRI (liftI (inum $ reRunIter $ insIter s)) >>= getIter+       >>= liftI . runIterRMC (insCtl s)+  iput s { insIter = r }+  let done = not $ isIterActive r+  if done && insAutoDone s then idone else return done+    where+      getIter (Right i) = return i+      getIter (Left r@(Fail _ (Just i) _)) = do+               imodify $ \s -> s { insIter = i }+               reRunIter r+      getIter (Left r) = reRunIter r++-- | Apply an 'Onum' (or 'Inum' of an arbitrary, unused input type) to+-- the 'Iter' from within the 'InumM' monad.  As with 'ifeed', returns+-- @'True'@ when the 'Iter' is finished.+irun :: (ChunkData tAny, ChunkData tIn, ChunkData tOut, Monad m) =>+        Inum tAny tOut m a -> InumM tIn tOut m a Bool+irun onum = ipipe $ runI . onum++-- | Repeats an action until the 'Iter' is done or an EOF error is+-- thrown.  (Also stops if a different kind of exception is thrown, in+-- which case the exception propagates further and may cause the+-- 'Inum' to fail.)  @irepeat@ sets both the /AutoEOF/ and+-- /AutoDone/ flags to @'True'@.+irepeat :: (ChunkData tIn, Monad m) =>+           InumM tIn tOut m a b -> InumM tIn tOut m a ()+irepeat action = do+  imodify $ \s -> s { insAutoEOF = True, insAutoDone = True }+  let loop = action >> loop in loop++-- | If the target 'Iter' being fed by the 'Inum' is no longer active+-- (i.e., if it is in the 'Done' state or in an error state), this+-- funciton pops the residual data out of the 'Iter' and returns it.+-- If the target is in any other state, returns 'mempty'.+ipopresid :: (ChunkData tIn, ChunkData tOut, Monad m) =>+             InumM tIn tOut m a tOut+ipopresid = do+  s <- iget+  case insIter s of+    r | isIterActive r -> return mempty+      | otherwise      -> do let (Chunk t _) = getResid r+                             iput s { insIter = setResid r mempty }+                             return t++-- | Immediately perform a successful exit from an 'InumM' monad,+-- terminating the 'Inum' and returning the current state of the+-- target 'Iter'.  Can be used to end an 'irepeat' loop.  (Use+-- @'throwI' ...@ for an unsuccessful exit.)+idone :: (ChunkData tIn, Monad m) => InumM tIn tOut m a b+idone = setAutoEOF True >> throwEOFI "idone"

@@ -0,0 +1,1020 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++module Data.IterIO.Iter+    (-- * Base types+     ChunkData(..), Chunk(..), chunk, chunkEOF+    , Iter(..), CtlCmd, CtlRes(..), CtlArg(..), IterFail(..)+    , IterR(..), iterF+    , isIterActive, iterShows, iterShow+    -- * Execution+    , run, runI+    -- * Exception types+    , mkIterEOF+    , IterCUnsupp(..)+    -- * Exception-related functions+    , throwI, throwEOFI, throwParseI+    , catchI, tryI, tryFI, tryRI, tryEOFI+    , finallyI, onExceptionI+    , tryBI, tryFBI+    , ifParse, ifNoParse, multiParse+    -- * Some basic Iters+    , nullI, data0I, dataI, pureI, chunkI+    , whileNullI, peekI, atEOFI, ungetI+    , safeCtlI, ctlI+    -- * Internal functions+    , onDone, fmapI+    , onDoneR, stepR, stepR', runR, fmapR, reRunIter, runIterR+    , getResid, setResid+    ) where++import Prelude hiding (null)+import qualified Prelude+import Control.Applicative (Applicative(..), (<$), (<$>))+import Control.Exception (SomeException(..), ErrorCall(..), Exception(..)+                         , try, throw)+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Trans+import Data.IORef+import Data.Maybe+import Data.Monoid+import Data.Typeable+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import System.IO.Error (mkIOError, eofErrorType, isEOFError)+import System.IO.Unsafe++--+-- Iteratee types and instances+--++-- | @ChunkData@ is the class of data types that can be output by an+-- enumerator and iterated on with an iteratee.  A @ChunkData@ type+-- must be a 'Monoid', but must additionally provide a predicate,+-- @null@, for testing whether an object is equal to 'mempty'.+-- Feeding a @null@ chunk to an iteratee followed by any other chunk+-- should have the same effect as just feeding the second chunk.  To+-- simplify debugging, there is an additional requirement that+-- @ChunkData@ be convertable to a String with the @chunkShow@ method.+--+-- Note that because the "Prelude" contains a function 'Prelude.null'+-- for lists, you may wish to include the import:+--+-- > import Prelude hiding (null)+--+class (Monoid t) => ChunkData t where+    null :: t -> Bool+    chunkShow :: t -> String+instance (Show a) => ChunkData [a] where+    {-# INLINE null #-}+    null = Prelude.null+    chunkShow = show+instance ChunkData L.ByteString where+    {-# INLINE null #-}+    null = L.null+    chunkShow = show . L8.unpack+instance ChunkData S.ByteString where+    {-# INLINE null #-}+    null = S.null+    chunkShow = show . S8.unpack+instance ChunkData () where+    {-# INLINE null #-}+    null _ = True+    chunkShow _ = "()"++-- | @Chunk@ is a wrapper around a 'ChunkData' type that also includes+-- an EOF flag that is 'True' if the data is followed by an+-- end-of-file condition.  An 'Iter' that receives a @Chunk@ with EOF+-- 'True' must return a result (or failure); it is an error to demand+-- more data (return 'IterF') after an EOF.+data Chunk t = Chunk !t !Bool deriving (Eq, Typeable)++instance (ChunkData t) => Show (Chunk t) where+    showsPrec _ (Chunk t eof) rest =+        chunkShow t ++ if eof then "+EOF" ++ rest else rest++instance Functor Chunk where+    {-# INLINE fmap #-}+    fmap f (Chunk t eof) = Chunk (f t) eof++instance (ChunkData t) => Monoid (Chunk t) where+    {-# INLINE mempty #-}+    mempty = Chunk mempty False++    {-# INLINABLE mappend #-}+    mappend ca@(Chunk a eofa) cb@(Chunk b eofb)+        | eofa      = error $ "mappend to EOF: " ++ show ca+                                           ++ " `mappend` " ++ show cb+        | null b    = Chunk a eofb -- Just an optimization for case below+        | otherwise = Chunk (mappend a b) eofb++-- | A 'Chunk' is 'null' when its data is 'null' and its EOF flag is+-- 'False'.+instance (ChunkData t) => ChunkData (Chunk t) where+    {-# INLINE null #-}+    null (Chunk t False) = null t+    null (Chunk _ True)  = False+    chunkShow = show++-- | Constructor function that builds a chunk containing data and a+-- 'False' EOF flag.+chunk :: t -> Chunk t+{-# INLINE chunk #-}+chunk t = Chunk t False++-- | An chunk with 'mempty' data and the EOF flag 'True'.+chunkEOF :: (Monoid t) => Chunk t+{-# INLINE chunkEOF #-}+chunkEOF = Chunk mempty True++-- | The basic Iteratee type is @Iter t m a@, where @t@ is the type of+-- input (in class 'ChunkData'), @m@ is a monad in which the iteratee+-- may execute actions (using the 'MonadTrans' 'lift' method), and @a@+-- is the result type of the iteratee.+--+-- Internally, an @Iter@ is a function from an input 'Chunk' to a+-- result of type 'IterR'.+newtype Iter t m a = Iter { runIter :: Chunk t -> IterR t m a }++-- | Builds an 'Iter' that keeps requesting input until it receives a+-- non-'null' 'Chunk'.  In other words, the 'Chunk' fed to the+-- argument function is guaranteed either to contain data or to have+-- the EOF flag true (or both).+iterF :: (ChunkData t) => (Chunk t -> IterR t m a) -> Iter t m a+{-# INLINE iterF #-}+iterF f = loop+    where loop = Iter $ \c -> if null c then IterF $ loop else f c++-- | Class of control commands for enclosing enumerators.  The class+-- binds each control argument type to a unique result type.+class (Typeable carg, Typeable cres) => CtlCmd carg cres | carg -> cres++-- | The outcome of an 'IterC' request.+data CtlRes a = CtlUnsupp+              -- ^ The request type was not supported by the enumerator.+              | CtlFail !SomeException+              -- ^ The request was supported, and executing it caused+              -- an exception to be thrown.+              | CtlDone !a+              -- ^ The result of the control operation.+              deriving (Typeable)++-- | Used when an 'Iter' is issuing a control request to an enclosing+-- enumerator.  Note that unlike 'IterF' or 'IterM', control requests+-- expose the residual data, which is ordinarily fed right back to the+-- continuation upon execution of the request.  This allows certain+-- control operations (such as seek and tell) to flush, check the+-- length of, or adjust the residual data.+data CtlArg t m a = forall carg cres. (CtlCmd carg cres) =>+    CtlArg !carg (CtlRes cres -> Iter t m a) (Chunk t)++-- | Contains information about a failed 'Iter'.  Failures of type+-- 'IterException' must be caught by 'catchI' (or 'tryI', etc.).+-- However, any other type of failure is considered a parse error, and+-- will be caught by 'multiParse', 'ifParse', and 'mplus'.+data IterFail = IterException !SomeException+              -- ^ An actual error occured that is not a parse error,+              -- EOF, etc.+              | IterExpected [(String, String)]+              -- ^ List of @(input_seen, input_expected)@ pairs.+              | IterEOFErr IOError+              -- ^ An EOF error occurred, either in some IO action+              -- wrapped by 'liftIO', or in some 'Iter' that called+              -- 'throwEOFI'.+              | IterParseErr String+              -- ^ A miscellaneous parse error occured.+              | IterMzero+              -- ^ What you get from 'mzero'.  Useful if you don't+              -- want to specify any information about the failure.+                deriving (Typeable)++instance Show IterFail where+    showsPrec _ (IterException e) rest = shows e rest+    showsPrec _ (IterExpected swl) rest =+        "Input failed to match all expectations\n" ++ fmt swl+        where fmt []    = rest+              fmt ((saw, expected):t) =+                  " expected " ++ show expected ++ ", saw "+                       ++ (take 50 $ show saw) ++ "\n" ++ fmt t+    showsPrec _ (IterEOFErr e) rest    = "IterEOFErr: " ++ shows e rest+    showsPrec _ (IterParseErr e) rest  = "IterParseErr: " ++ e ++ rest+    showsPrec _ IterMzero rest         = "IterMZero" ++ rest++instance Exception IterFail where+    {-# INLINE toException #-}+    toException (IterException e) = e+    toException (IterEOFErr e)    = toException e+    toException e                 = SomeException e++-- | An @IterR@ is the result of feeding a chunk of data to an 'Iter'.+-- An @IterR@ is in one of several states:  it may require more input+-- ('IterF'), it may wish to execute monadic actions in the+-- transformed monad ('IterM'), it may have a control request for an+-- enclosing enumerator ('IterC'), it may have produced a result+-- ('Done'), or it may have failed ('Fail').+data IterR t m a = IterF !(Iter t m a)+                 -- ^ The iteratee requires more input.+                 | IterM !(m (IterR t m a))+                 -- ^ The iteratee must execute monadic bind in monad @m@+                 | IterC !(CtlArg t m a)+                 -- ^ A control request (see 'CtlArg').+                 | Done a (Chunk t)+                 -- ^ Sufficient input was received; the 'Iter' is+                 -- returning a result of type @a@.  In adition, the+                 -- 'IterR' has a 'Chunk' containing any residual+                 -- input that was not consumed in producing the+                 -- result.+                 | Fail !IterFail !(Maybe a) !(Maybe (Chunk t))+                 -- ^ The 'Iter' failed.  If it was an enumerator, the+                 -- target 'Iter' that the enumerator was feeding+                 -- likely has not failed, in which case its current+                 -- state is returned in the @Maybe a@.  If it makes+                 -- sense to preserve the state of the input stream+                 -- (which it does for most errors except parse+                 -- errors), then the third parameter includes the+                 -- residual 'Chunk' at the time of the failure.++-- | True if an 'IterR' is requesting something from an+-- enumerator--i.e., the 'IterR' is not 'Done' or 'Fail'.+isIterActive :: IterR t m a -> Bool+{-# INLINE isIterActive #-}+isIterActive (IterF _)     = True+isIterActive (IterM _)     = True+isIterActive (IterC _)     = True+isIterActive _             = False++-- | Show the current state of an 'IterR', prepending it to some+-- remaining input (the standard 'ShowS' optimization), when 'a' is in+-- class 'Show'.  Note that if @a@ is not in 'Show', you can simply+-- use the 'shows' function.+iterShows :: (ChunkData t, Show a) => IterR t m a -> ShowS+iterShows (IterC (CtlArg a _ c)) rest =+    "IterC " ++ (shows (typeOf a) $ " _ " ++ shows c rest)+iterShows (Done a c) rest = "Done " ++ (shows a $ " " ++ shows c rest)+iterShows (Fail e a c) rest =+    "Fail " ++ (shows e $ " (" ++ (shows a $ ") " ++ shows c rest))+iterShows iter rest = shows iter rest++-- | Show the current state of an 'Iter' if type @a@ is in the 'Show'+-- class.  (Otherwise, you can simply use the ordinary 'show'+-- function.)+iterShow :: (ChunkData t, Show a) => IterR t m a -> String+iterShow iter = iterShows iter ""++instance (ChunkData t) => Show (IterR t m a) where+    showsPrec _ (IterF _) rest = "IterF _" ++ rest+    showsPrec _ (IterM _) rest = "IterM _" ++ rest+    showsPrec _ (IterC (CtlArg a _ c)) rest =+        "IterC " ++ (shows (typeOf a) $ " _" ++ shows c rest)+    showsPrec _ (Done _ c) rest = "Done _ " ++ shows c rest+    showsPrec _ (Fail e a c) rest =+        "Fail " ++ (shows e $+                        (if isJust a then " Just _ " else " Nothing ")+                        ++ shows c rest)++iterTc :: TyCon+iterTc = mkTyCon "Iter"+instance (Typeable t, Typeable1 m) => Typeable1 (Iter t m) where+    typeOf1 iter = mkTyConApp iterTc [typeOf $ t iter, typeOf1 $ m iter]+        where t :: Iter t m a -> t; t _ = undefined+              m :: Iter t m a -> m (); m _ = undefined++instance (Typeable t, Typeable1 m, Typeable a) => Typeable (Iter t m a) where+    typeOf = typeOfDefault++instance (Monad m) => Functor (Iter t m) where+    {-# INLINE fmap #-}+    fmap = fmapI++-- | @fmapI@ is like 'liftM', but differs in one important respect:+-- it preserves the failed result of an enumerator (and in fact+-- applies the function to the non-failed target 'Iter' state).  By+-- contrast, 'liftM', which is equivalent to @'liftM' f i = i '>>='+-- 'return' . f@, transforms the @'Maybe' a@ component of all 'Fail'+-- states to 'Nothing' because of its use of '>>='.+fmapI :: (Monad m) => (a -> b) -> Iter t m a -> Iter t m b+{-# INLINE fmapI #-}+fmapI = onDone . fmapR++-- | Maps the result of an 'IterR' like 'fmap', but only if the+-- 'IterR' is no longer active.  It is an error to call this function+-- on an 'IterR' in the 'IterF', 'IterM', or 'IterC' state.  Because+-- of this restriction, @fmapR@ does not require the input and output+-- 'Monad' types (@m1@ and @m2@) to be the same.+fmapR :: (a -> b) -> IterR t m1 a -> IterR t m2 b+{-# INLINE fmapR #-}+fmapR f (Done a c)   = Done (f a) c+fmapR f (Fail e a c) = Fail e (fmap f a) c+fmapR _ (IterF _)    = error "fmapR (IterF)"+fmapR _ (IterM _)    = error "fmapR (IterM)"+fmapR _ (IterC _)    = error "fmapR (IterC)"++instance (Monad m) => Functor (IterR t m) where+    fmap = onDoneR . fmapR++instance (Monad m) => Applicative (Iter t m) where+    pure   = return+    (<*>)  = ap+    (*>)   = (>>)+    a <* b = do r <- a; b >> return r++instance (Monad m) => Monad (Iter t m) where+    {-# INLINE return #-}+    return a = Iter $ Done a++    {-# INLINE (>>=) #-}+    -- Because check calls itself and (>>=) recursively, IterF and+    -- IterM likely cannot be inlined.  However, inlining Done and+    -- Fail (which can occur quite often for parsing failures) in the+    -- first part of this function seems to give about a 1-2% speedup.+    m >>= k = Iter $ \c0 -> case runIter m c0 of+                              (Done a c)   -> runIter (k a) c+                              (Fail e _ c) -> Fail e Nothing c+                              r          -> check r+        where check (IterM mm)             = IterM $ mm >>= return . check+              check (IterF i)              = IterF $ i >>= k+              check (IterC (CtlArg a n c)) = IterC $ CtlArg a (n >=> k) c+              check (Fail e _ c)           = Fail e Nothing c+              check (Done a c)             = runIter (k a) c++    fail msg = Iter $ Fail (IterException $ toException $ ErrorCall msg)+                                       Nothing . Just++instance (ChunkData t, Monad m) => MonadPlus (Iter t m) where+    {-# INLINE mzero #-}+    mzero = Iter $ const $ Fail IterMzero Nothing Nothing+    mplus a b = ifParse a return b++instance MonadTrans (Iter t) where+    {-# INLINE lift #-}+    lift m = Iter $ \c -> IterM $ m >>= \a -> return $ Done a c++-- | The 'Iter' instance of 'MonadIO' handles errors specially.  If+-- the lifted operation throws an exception, 'liftIO' catches the+-- exception and returns it as an 'IterFail' failure.  If the+-- exception is an 'IOError' satisfying 'isEOFError', then the+-- exception is wrapped in the 'IterEOFErr' constructor; otherwise, it+-- is wrapped in 'IterException' otherwise.  This approach allows+-- efficient testing for EOF errors without the need to invoke the+-- expensive 'cast' or 'fromException' operations.  (Yes @liftIO@ uses+-- these expensive operations, but 'Iter's that invoke 'throwEOFI' do+-- not.)+--+-- One consequence of this exception handling is that with 'Iter',+-- unlike with most monad transformers, 'liftIO' is /not/ equivalent+-- to some number of nested calls to 'lift'.  See the documentation of+-- '.|$' for an example.+instance (MonadIO m) => MonadIO (Iter t m) where+    liftIO m = Iter $ \c -> IterM $ liftIO $ do+      result <- try m                           +      case result of+        Right ok -> return $ Done ok c+        Left se -> return $ case fromException se of+          Just e | isEOFError e -> Fail (IterEOFErr e) Nothing (Just c)+          _ -> Fail (IterException se) Nothing (Just c)++-- | This is a generalization of 'fixIO' for arbitrary members of the+-- 'MonadIO' class.+fixMonadIO :: (MonadIO m) => (a -> m a) -> m a+fixMonadIO f = do+  ref <- liftIO $ newIORef $ throw $ toException+         $ ErrorCall "fixMonadIO: non-termination"+  a <- liftIO $ unsafeInterleaveIO $ readIORef ref+  r <- f a+  liftIO $ writeIORef ref r+  return r++instance (MonadIO m) => MonadFix (Iter t m) where+    mfix = fixMonadIO++--+-- Core functions+--++-- | Feed an EOF to an 'Iter' and return the result.  Throws an+-- exception if there has been a failure.+run :: (ChunkData t, Monad m) => Iter t m a -> m a+run i0 = check $ runIter i0 chunkEOF+    where check (Done a _)                   = return a+          check (IterF i)                    = run i+          check (IterM m)                    = m >>= check+          check (IterC (CtlArg _ n c))       = check $ runIter (n CtlUnsupp) c+          check (Fail (IterException e) _ _) = throw e+          check (Fail e _ _)                 = throw e++-- | The equivalent for 'runI' for 'IterR's.+runR :: (ChunkData t1, ChunkData t2, Monad m) => IterR t1 m a -> IterR t2 m a+{-# INLINABLE runR #-}+runR (Done a _)             = Done a mempty+runR (IterF i)              = runR $ runIter i chunkEOF+runR (IterM m)              = IterM $ liftM runR m+runR (IterC (CtlArg _ n c)) = runR $ runIter (n CtlUnsupp) c+runR (Fail e a c)           = Fail e a $ mempty <$ c++-- | Runs an 'Iter' from within a different 'Iter' monad.  If+-- successful, @runI iter@ will produce the same result as @'lift'+-- ('run' iter)@.  However, if @iter@ fails, 'run' throws a+-- language-level exception, which cannot be caught within other+-- 'Iter' monads.  By contrast, @runI@ throws a monadic exception that+-- can be caught.  In short, use @runI@ in preference to @run@ in+-- situations where both are applicable.  See a more detailed+-- discussion of the same issue with examples in the documentation for+-- @'.|$'@ in "Data.IterIO.Inum".+runI :: (ChunkData t1, ChunkData t2, Monad m) => Iter t1 m a -> Iter t2 m a+{-# INLINABLE runI #-}+runI i = Iter $ runIterR (runR $ runIter i chunkEOF)++--+-- Exceptions+--++-- | Make an 'IterEOFErr' from a String.+mkIterEOF :: String -> IterFail+mkIterEOF loc = IterEOFErr $ mkIOError eofErrorType loc Nothing Nothing++-- | Exception thrown by 'CtlI' when the type of the control request+-- is not supported by the enclosing enumerator.+data IterCUnsupp = forall carg cres. (CtlCmd carg cres) =>+                   IterCUnsupp carg deriving (Typeable)+instance Show IterCUnsupp where+    showsPrec _ (IterCUnsupp carg) rest =+        "Unsupported control request " ++ shows (typeOf carg) rest+instance Exception IterCUnsupp+++--+-- Exception functions+--+-- | Throw an exception from an Iteratee.  The exception will be+-- propagated properly through nested Iteratees, which will allow it+-- to be categorized properly and avoid situations in which resources+-- such as file handles are not released.  (Most iteratee code does+-- not assume the Monad parameter @m@ is in the 'MonadIO' class, and+-- hence cannot use 'catch' or @'onException'@ to clean up after+-- exceptions.)  Use 'throwI' in preference to 'throw' whenever+-- possible.+--+-- Do not use @throwI@ to throw parse errors or EOF errors.  Use+-- 'throwEOFI' and 'throwParseI' instead.  For performance reasons,+-- the 'IterFail' type segregates EOF and parse errors from other+-- types of failures.+throwI :: (Exception e) => e -> Iter t m a+throwI e = Iter $ Fail (IterException $ toException e) Nothing . Just++-- | Throw an exception of type 'IterEOF'.  This will be interpreted+-- by 'mkInum' as an end of file chunk when thrown by the codec.  It+-- will also be interpreted by 'ifParse' and 'multiParse' as parsing+-- failure.  If not caught within the 'Iter' monad, the exception will+-- be rethrown by 'run' (and hence '|$') as an 'IOError' of type EOF.+throwEOFI :: String -> Iter t m a+{-# INLINE throwEOFI #-}+throwEOFI s = Iter $ Fail (mkIterEOF s) Nothing . Just++-- | Throw a miscellaneous parse error (after which input is assumed+-- to be unsynchronized and thus is discarded).  Parse errors may be+-- caught as exception type 'IterFail', but they can also be caught+-- more efficiently by the functions 'multiParse', 'ifParse', and+-- 'mplus'.+throwParseI :: String -> Iter t m a+{-# INLINE throwParseI #-}+throwParseI s = Iter $ \_ -> Fail (IterParseErr s) Nothing Nothing++-- | Run an 'Iter'.  Catch any exception it throws (and return the+-- failing iter state).  Transform successful results with a function.+--+-- This function is slightly more general than 'catchI'.  For+-- instance, we can't implement 'tryI' in terms of just 'catchI'.+-- Something like+--+-- > tryI iter = catchI (iter >>= return . Right) ...+--+-- would remove the possibly unfailed 'Iter' state from failed 'Inum'+-- results, because the '>>=' operator has this effect.  (I.e., if+-- @iter@ is @'Fail' e ('Just' i) c@, the expression @iter >>= return+-- . Right@ will be @'Fail' e Nothing c@.)  This could be particularly+-- bad in cases where the exception is not even of a type caught by+-- the 'tryI' expression.+--+-- Similarly, trying to implement 'catchI' in terms of 'tryI' doesn't+-- quite work.  Something like+--+-- > catchI iter handler = tryI iter >>= either (uncurry handler) return+--+-- would erase state from 'Inum' failures /not/ caught by the handler.+genCatchI :: (ChunkData t, Monad m, Exception e) =>+             Iter t m a+          -- ^ 'Iter' that might throw an exception+          -> (e -> IterR t m a -> Iter t m b) +          -- ^ Exception handler+          -> (a -> b)+          -- ^ Conversion function for result and 'InumFail' errors.+          -> Iter t m b+genCatchI iter0 handler conv = onDone check iter0+    where check (Done a c) = Done (conv a) c+          check r@(Fail e0 _ _) =+              case fromException $ toException e0 of+                Just e  -> runIter (handler e $ setResid r mempty) (getResid r)+                Nothing -> fmap conv r+          check _ = error "genCatchI"++-- | Catch an exception thrown by an 'Iter', including exceptions+-- thrown by any 'Inum's fused to the 'Iter' (or applied to it with+-- '.|$').  If you wish to catch just errors thrown within 'Inum's,+-- see the function @'inumCatch'@ in "Data.IterIO.Inum".+--+-- On exceptions, @catchI@ invokes a handler passing it both the+-- exception thrown and the state of the failing 'IterR', which may+-- contain more information than just the exception.  In particular,+-- if the exception occured in an 'Inum', the returned 'IterR' will+-- also contain the 'IterR' being fed by that 'Inum', which likely+-- will not have failed.  To avoid discarding this extra information,+-- you should not re-throw exceptions with 'throwI'.  Rather, you+-- should re-throw an exception by re-executing the failed 'IterR'+-- with 'reRunIter'.  For example, a possible definition of+-- 'onExceptionI' is:+--+-- @+--  onExceptionI iter cleanup =+--      iter \`catchI\` \\('SomeException' _) r -> cleanup >> 'reRunIter' r+-- @+--+-- Note that @catchI@ only works for /synchronous/ exceptions, such as+-- IO errors (thrown within 'liftIO' blocks), the monadic 'fail'+-- operation, and exceptions raised by 'throwI'.  It is not possible+-- to catch /asynchronous/ exceptions, such as lazily evaluated+-- divide-by-zero errors, the 'throw' function, or exceptions raised+-- by other threads using @'throwTo'@ if those exceptions might arrive+-- anywhere outside of a 'liftIO' call.+--+-- @\`catchI\`@ has the default infix precedence (@infixl 9+-- \`catchI\`@), which binds more tightly than any concatenation or+-- fusing operators.+catchI :: (Exception e, ChunkData t, Monad m) =>+          Iter t m a+       -- ^ 'Iter' that might throw an exception+       -> (e -> IterR t m a -> Iter t m a)+       -- ^ Exception handler, which gets as arguments both the+       -- exception and the failing 'Iter' state.+       -> Iter t m a+{-# INLINE catchI #-}+catchI iter handler = genCatchI iter handler id++-- | 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'.+tryI :: (ChunkData t, Monad m, Exception e) =>+        Iter t m a -> Iter t m (Either (e, IterR t m a) a)+{-# INLINE tryI #-}+tryI iter = genCatchI iter (curry $ return . Left) Right++-- | A version of 'tryI' that catches all exceptions.  Instead of+-- returning the exception caught, it returns the failing 'IterR'+-- (from which you can extract the exception if you really want it).+-- The main use of this is for doing some kind of clean-up action,+-- then re-throwing the exception with 'reRunIter'.+--+-- For example, the following is a possible implementation of 'finallyI':+--+-- > finallyI iter cleanup = do+-- >   er <- tryRI iter+-- >   cleanup+-- >   either reRunIter return er+tryRI :: (ChunkData t, Monad m) =>+         Iter t m a -> Iter t m (Either (IterR t m a) a)+tryRI = onDone check+    where check (Fail e a c) = Done (Left $ Fail e a $ Just mempty) $+                               fromMaybe mempty c+          check r = Right <$> r++-- | A variant of 'tryI' that just catches EOF errors.  Returns+-- 'Nothing' after an EOF error, and 'Just' the result otherwise.+-- Should be much faster than trying to catch an EOF error of type+-- 'Exception'.+tryEOFI :: (ChunkData t, Monad m) =>+           Iter t m a -> Iter t m (Maybe a)+tryEOFI = onDone check+    where check (Fail (IterEOFErr _) _ c) = Done Nothing $ fromMaybe mempty c+          check r                         = Just <$> r++-- | A varient of 'tryI' that returns the 'IterFail' state rather than+-- trying to match a particular exception.+tryFI :: (ChunkData t, Monad m) =>+         Iter t m a -> Iter t m (Either IterFail a)+tryFI = onDone check+    where check (Fail e _ c) = Done (Left e) $ fromMaybe mempty c+          check r            = Right <$> r++-- | Execute an 'Iter', then perform a cleanup action regardless of+-- whether the 'Iter' threw an exception or not.  Analogous to the+-- standard library function @'finally'@.+finallyI :: (ChunkData t, Monad m) =>+            Iter t m a -> Iter t m b -> Iter t m a+finallyI iter cleanup = do er <- tryRI iter+                           cleanup >> either reRunIter return er++-- | Execute an 'Iter' and perform a cleanup action if the 'Iter'+-- threw an exception.  Analogous to the standard library function+-- @'onException'@.+onExceptionI :: (ChunkData t, Monad m) =>+                Iter t m a -> Iter t m b -> Iter t m a+onExceptionI iter cleanup =+    catchI iter $ \(SomeException _) r -> cleanup >> reRunIter r++-- | Simlar to 'tryI', but saves all data that has been fed to the+-- 'Iter', and rewinds the input if the 'Iter' fails.  (The @B@ in+-- @tryBI@ stands for \"backtracking\".)  Thus, if @tryBI@ returns+-- @'Left' exception@, the next 'Iter' to be invoked will see the same+-- input that caused the previous 'Iter' to fail.  (For this reason,+-- it makes no sense ever to call @'resumeI'@ on the 'Iter' you get+-- back from @tryBI@, which is why @tryBI@ does not return the failing+-- Iteratee the way 'tryI' does.)+--+-- Because @tryBI@ saves a copy of all input, it can consume a lot of+-- memory and should only be used when the 'Iter' argument is known to+-- consume a bounded amount of data.+tryBI :: (ChunkData t, Monad m, Exception e) =>+         Iter t m a -> Iter t m (Either e a)+tryBI = onDoneInput errToEither+    where errToEither (Done a c) _ = Done (Right a) c+          errToEither r@(Fail ie _ _) c =+              case fromException $ toException ie of+                Just e  -> Done (Left e) c+                Nothing -> Right <$> r+          errToEither _ _ = error "tryBI"++-- | A variant of 'tryBI' that, also rewinds input on failure, but+-- returns the raw 'IterFail' structure, rather than mapping it to a+-- particular exception.  This is much faster because it requires no+-- dynamic casts.  However, the same warning applies that @tryFBI@+-- should not be applied to 'Iter's that could take unbounded input.+tryFBI :: (ChunkData t, Monad m) =>+          Iter t m a -> Iter t m (Either IterFail a)+tryFBI = onDoneInput check+    where check (Done a c) _   = Done (Right a) c+          check (Fail e _ _) c = Done (Left e) c+          check _ _ = error "tryFBI"++{-+mapIterFail :: (ChunkData t, Monad m) =>+               (IterFail -> IterFail) -> Iter t m a -> Iter t m a+mapIterFail f = onDone check+    where check (Fail e a c) = Fail (f e) a c+          check r            = r+-}++-- | Run an Iteratee, and if it throws a parse error by calling+-- 'expectedI', then combine the exptected tokens with those of a+-- previous parse error.+combineExpected :: (ChunkData t, Monad m) =>+                   IterFail+                -- ^ Previous parse error+                -> IterR t m a+                -- ^ Result of second 'Iter'--if it fails the error+                -- should be combined with the first error+                -> IterR t m a+combineExpected _ r@(Done _ _) = r+combineExpected (IterExpected l1) (Fail (IterExpected l2) _ _) =+    Fail (IterExpected $ l1 ++ l2) Nothing Nothing+combineExpected _ r@(Fail (IterExpected _) _ _) = r+combineExpected e _ = Fail e Nothing Nothing++-- | Try two Iteratees and return the result of executing the second+-- if the first one throws a parse, EOF, or 'mzero' error.  Note that+-- "Data.IterIO.Parse" defines @'<|>'@ as an infix synonym for this+-- function.+--+-- The statement @multiParse a b@ is similar to @'ifParse' a return+-- b@, but the two functions operate differently.  Depending on the+-- situation, only one of the two formulations may be correct.+-- Specifically:+-- +--  * @'ifParse' a f b@ works by first executing @a@, saving a copy of+--    all input consumed by @a@.  If @a@ throws a parse error, the+--    saved input is used to backtrack and execute @b@ on the same+--    input that @a@ just rejected.  If @a@ succeeds, @b@ is never+--    run; @a@'s result is fed to @f@, and the resulting action is+--    executed without backtracking (so any error thrown within @f@+--    will not be caught by this 'ifParse' expression).+--+--  * Instead of saving input, @multiParse a b@ executes both @a@ and+--    @b@ concurrently as input chunks arrive.  If @a@ throws a parse+--    error, then the result of executing @b@ is returned.  If @a@+--    either succeeds or throws an exception that is not a parse+--    error/EOF/'mzero', then the result of running @a@ is returned.+--+--  * With @multiParse a b@, if @b@ returns a value, executes a+--    monadic action via 'lift', or issues a control request via+--    'ctlI', then further processing of @b@ will be suspended until+--    @a@ experiences a parse error, and thus the behavior will be+--    equivalent to @'ifParse' a return b@.+--+-- The main restriction on 'ifParse' is that @a@ must not consume+-- unbounded amounts of input, or the program may exhaust memory+-- saving the input for backtracking.  Note that the second argument+-- to 'ifParse' (i.e., 'return' in @ifParse a return b@) is a+-- continuation for @a@ when @a@ succeeds.+--+-- The advantage of @multiParse@ is that it can avoid storing+-- unbounded amounts of input for backtracking purposes if both+-- 'Iter's consume data.  Another advantage is that with an expression+-- such as @'ifParse' a f b@, sometimes it is not convenient to break+-- the parse target into an action to execute with backtracking (@a@)+-- and a continuation to execute without backtracking (@f@).  The+-- equivalent @multiParse (a >>= f) b@ avoids the need to do this,+-- since it does not do backtracking.+--+-- However, it is important to note that it is still possible to end+-- up storing unbounded amounts of input with @multiParse@.  For+-- example, consider the following code:+--+-- > total :: (Monad m) => Iter String m Int+-- > total = multiParse parseAndSumIntegerList (return -1) -- Bad+--+-- Here the intent is for @parseAndSumIntegerList@ to parse a+-- (possibly huge) list of integers and return their sum.  If there is+-- a parse error at any point in the input, then the result is+-- identical to having defined @total = return -1@.  But @return -1@+-- succeeds immediately, consuming no input, which means that @total@+-- must return all left-over input for the next action (i.e., @next@+-- in @total >>= next@).  Since @total@ has to look arbitrarily far+-- into the input to determine that @parseAndSumIntegerList@ fails, in+-- practice @total@ will have to save all input until it knows that+-- @parseAndSumIntegerList@ succeeds.+--+-- A better approach might be:+--+-- @+--   total = multiParse parseAndSumIntegerList ('nullI' >> return -1)+-- @+--+-- Here 'nullI' discards all input until an EOF is encountered, so+-- there is no need to keep a copy of the input around.  This makes+-- sense so long as @total@ is the last or only Iteratee run on the+-- input stream.  (Otherwise, 'nullI' would have to be replaced with+-- an Iteratee that discards input up to some end-of-list marker.)+--+-- Another approach might be to avoid parsing combinators entirely and+-- use:+--+-- @+--   total = parseAndSumIntegerList ``catchI`` handler+--       where handler \('IterNoParse' _) _ = return -1+-- @+--+-- This last definition of @total@ may leave the input in some+-- partially consumed state.  This is fine so long as @total@ is the+-- last 'Iter' executed on the input stream.  Otherwise, before+-- throwing the parse error, @parseAndSumIntegerList@ would need to+-- ensure the input is at some reasonable boundary point for whatever+-- comes next.  (The 'ungetI' function is sometimes helpful for this+-- purpose.)+multiParse :: (ChunkData t, Monad m) =>+              Iter t m a -> Iter t m a -> Iter t m a+multiParse a b = Iter $ \c -> check (runIter a c) (runIter b c)+    where+      check ra@(Done _ _) _ = ra+      check (IterF ia) (IterF ib) = IterF $ multiParse ia ib+      check (IterF ia) rb =+          IterF $ onDoneInput (\ra c -> check ra (runIterR rb c)) ia+      check ra rb = stepR ra (flip check rb) $ case ra of+                      (Fail (IterException _) _ _) -> ra+                      (Fail e _ _) -> onDoneR (combineExpected e) rb+                      _ -> error "multiParse"++-- | @ifParse iter success failure@ runs @iter@, but saves a copy of+-- all input consumed using 'tryFBI'.  (This means @iter@ must not+-- consume unbounded amounts of input!  See 'multiParse' for such+-- cases.)  If @iter@ succeeds, its result is passed to the function+-- @success@.  If @iter@ throws a parse error (with 'throwParseI'),+-- throws an EOF error (with 'throwEOFI'), or executes 'mzero', then+-- @failure@ is executed with the input re-wound (so that @failure@ is+-- fed the same input that @iter@ was).  If @iter@ throws any other+-- type of exception, @ifParse@ passes the exception back and does not+-- execute @failure@.+--+-- See "Data.IterIO.Parse" for a discussion of this function and the+-- related infix operator @\\/@ (which is a synonym for 'ifNoParse').+ifParse :: (ChunkData t, Monad m) =>+           Iter t m a+        -- ^ Iteratee @iter@ to run with backtracking+        -> (a -> Iter t m b)+        -- ^ @success@ function+        -> Iter t m b+        -- ^ @failure@ action+        -> Iter t m b+        -- ^ result+ifParse iter yes no = tryFBI iter >>= check+    where check (Right a) = yes a+          check (Left (IterException e)) = throwI e+          check (Left e) = onDone (combineExpected e) no+++-- | @ifNoParse@ is just 'ifParse' with the second and third arguments+-- reversed.+ifNoParse :: (ChunkData t, Monad m) =>+             Iter t m a -> Iter t m b -> (a -> Iter t m b) -> Iter t m b+{-# INLINE ifNoParse #-}+ifNoParse iter no yes = ifParse iter yes no+++--+-- Some super-basic Iteratees+--++-- | Sinks data like @\/dev\/null@, returning @()@ on EOF.+nullI :: (Monad m, ChunkData t) => Iter t m ()+nullI = Iter $ \(Chunk _ eof) ->+        if eof then Done () chunkEOF else IterF nullI++-- | Returns a non-empty amount of input data if there is any input+-- left.  Returns 'mempty' on an EOF condition.+data0I :: (ChunkData t) => Iter t m t+{-# INLINE data0I #-}+data0I = iterF $ \(Chunk d eof) -> Done d (Chunk mempty eof)++-- | Like 'data0I', but always returns non-empty data.  Throws an+-- exception on an EOF condition.+dataI :: (ChunkData t) => Iter t m t+{-# INLINE dataI #-}+dataI = iterF nextChunk+    where nextChunk c@(Chunk d True) | null d = Fail eoferr Nothing (Just c)+          nextChunk (Chunk d eof) = Done d (Chunk mempty eof)+          eoferr = mkIterEOF "dataI"++-- | A variant of 'data0I' that reads the whole input up to an EOF and+-- returns it.+pureI :: (Monad m, ChunkData t) => Iter t m t+pureI = do peekI nullI; Iter $ \(Chunk t _) -> Done t chunkEOF++-- | Returns the next 'Chunk' that either contains non-'null' data or+-- has the EOF bit set.+chunkI :: (Monad m, ChunkData t) => Iter t m (Chunk t)+{-# INLINE chunkI #-}+chunkI = iterF $ \c@(Chunk _ eof) -> Done c (Chunk mempty eof)++-- | 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+-- (i.e., usually non-'null') iteration.+whileNullI :: (ChunkData tIn, ChunkData tOut, Monad m) =>+              Iter tIn m tOut -> Iter tIn m tOut+whileNullI iter = loop+    where loop = do buf <- iter+                    if null buf+                      then do eof <- atEOFI+                              if eof then return buf else loop+                      else return buf++-- | Runs an 'Iter' then rewinds the input state, so that the effect+-- is to parse lookahead data.  (See 'tryBI' if you want to rewind the+-- input only when the 'Iter' fails.)+peekI :: (ChunkData t, Monad m) => Iter t m a -> Iter t m a+peekI = onDoneInput setResid++-- | Does not actually consume any input, but returns 'True' if there+-- is no more input data to be had.+atEOFI :: (Monad m, ChunkData t) => Iter t m Bool+atEOFI = iterF $ \c@(Chunk t _) -> Done (null t) c++-- | Place data back onto the input stream, where it will be the next+-- data consumed by subsequent 'Iter's.+ungetI :: (ChunkData t) => t -> Iter t m ()+{-# INLINE ungetI #-}+ungetI t = Iter $ \c -> Done () (mappend (chunk t) c)++-- | Issue a control request.  Returns 'CtlUnsupp' if the request type+-- is unsupported.  Otherwise, returns 'CtlDone' with the result if+-- the request succeeds, or return @'CtlFail'@ if the request type is+-- supported but attempting to execute the request caused an+-- exception.+safeCtlI :: (CtlCmd carg cres, Monad m) =>+            carg -> Iter t m (CtlRes cres)+safeCtlI carg = Iter $ IterC . CtlArg carg return++-- | Issue a control request and return the result.  Throws an+-- exception of type 'IterCUnsupp' if the operation type was not+-- supported by an enclosing enumerator.+ctlI :: (CtlCmd carg cres, ChunkData t, Monad m) =>+        carg -> Iter t m cres+ctlI carg = do+  res <- safeCtlI carg+  case res of+    CtlUnsupp    -> throwI $ IterCUnsupp carg+    CtlFail e    -> throwI e+    CtlDone cres -> return cres++--+-- Iter manipulation functions+--++-- | A variant of 'stepR' that only works for the 'IterF' and 'IterC'+-- states, not the 'IterM' state.  (Because of this additional+-- restriction, the input and output 'Monad' types @m1@ and @m2@ do+-- not need to be the same.)+stepR' :: IterR t m1 a+       -- ^ The 'IterR' that needs to be stepped.+       -> (IterR t m1 a -> IterR t m2 b)+       -- ^ Transformation function if the 'IterR' is in the 'IterF'+       -- or 'IterC' state.+       -> IterR t m2 b+       -- ^ Fallback if the 'IterR' is no longer active.+       -> IterR t m2 b+{-# INLINE stepR' #-}+stepR' (IterF (Iter i)) f _       = IterF $ Iter $ f . i+stepR' (IterC (CtlArg a n c)) f _ =+    IterC $ CtlArg a (Iter . (f .) . runIter . n) c+stepR' (IterM _) _ _              = error "stepR' (IterM)"+stepR' _ _ notActive              = notActive++-- | Step an active 'IterR' (i.e., one in the 'IterF', 'IterM', or+-- 'IterC' state) to its next state, and pass the result through a+-- function.+stepR :: (Monad m) =>+         IterR t m a+      -- ^ The 'Iter' that needs to be stepped+      -> (IterR t m a -> IterR t m b)+      -- ^ Function to pass the 'Iter' to after stepping it.+      -> IterR t m b+      -- ^ Fallback if the 'Iter' can no longer be stepped+      -> IterR t m b+{-# INLINE stepR #-}+stepR (IterM m) f _ = IterM $ liftM f m+stepR r f notActive = stepR' r f notActive++-- | The equivalent of 'onDone' for 'IterR's.+onDoneR :: (Monad m) =>+           (IterR t m a -> IterR t m b) -> IterR t m a -> IterR t m b+{-# INLINE onDoneR #-}+onDoneR f = check+    where check r = stepR r check $ f r++-- | Run an 'Iter' until it enters the 'Done' or 'Fail' state, then+-- use a function to transform the 'IterR'.+{-# INLINE onDone #-}+onDone :: (Monad m) =>+          (IterR t m a -> IterR t m b) -> Iter t m a -> Iter t m b+onDone f i = Iter $ onDoneR f . runIter i++-- | Like 'onDone', but also keeps a copy of all input consumed.  (The+-- residual input on the 'IterR' returned will be a suffix of the+-- input returned.)+onDoneInput :: (ChunkData t, Monad m) =>+               (IterR t m a -> Chunk t -> IterR t m b)+            -> Iter t m a+            -> Iter t m b+{-# INLINABLE onDoneInput #-}+onDoneInput f = Iter . next id+    where next acc iter c =+              let check (IterF i) = IterF $ Iter $ next (acc . mappend c) i+                  check r = stepR r check $ f r (acc c)+              in check $ runIter iter c++++-- | Get the residual data for an 'IterR' that is in no longer active+-- or that is in the 'IterC' state.  (It is an error to call this+-- function on an 'IterR' in the 'IterF' or 'IterM' state.)+getResid :: (ChunkData t) => IterR t m a -> Chunk t+{-# INLINABLE getResid #-}+getResid (Done _ c)             = c+getResid (Fail _ _ c)           = fromMaybe mempty c+getResid (IterC (CtlArg _ _ c)) = c+getResid (IterF _)              = error "getResid (IterF)"+getResid (IterM _)              = error "getResid (IterM)"++-- | Set residual data for an 'IterR' that is not active.  (It is an+-- error to call this on an 'IterR' in the 'Done', 'IterM', or 'IterC'+-- states.)+setResid :: IterR t1 m1 a -> Chunk t2 -> IterR t2 m2 a+{-# INLINABLE setResid #-}+setResid (Done a _)   = Done a+setResid (Fail e a _) = Fail e a . Just+setResid (IterF _)    = error "setResid (IterF)"+setResid (IterM _)    = error "setResid (IterM)"+setResid (IterC _)    = error "setResid (IterC)"++-- | Feed more input to an 'Iter' that has already been run (and hence+-- is already an 'IterR').  In the event that the 'IterR' is+-- requesting more input (i.e., is in the 'IterF' state), this is+-- straight forward.  However, if the 'Iter' is in some other state+-- such as 'IterM', this function needs to save the input until such+-- time as the 'IterR' is stepped to a new state (e.g., with 'stepR'+-- or 'reRunIter').+runIterR :: (ChunkData t, Monad m) => IterR t m a -> Chunk t -> IterR t m a+{-# INLINABLE runIterR #-}+runIterR r c = if null c then r else check r+    where check (Done a c0)             = Done a (mappend c0 c)+          check (IterF i)               = runIter i c+          check (IterM m)               = IterM $ liftM check m+          check (IterC (CtlArg a n c0)) = IterC $ CtlArg a n (mappend c0 c)+          check (Fail e a c0)           = Fail e a $ fmap (`mappend` c) c0++-- | Turn an 'IterR' back into an 'Iter'.+reRunIter :: (ChunkData t, Monad m) => IterR t m a -> Iter t m a+{-# INLINE reRunIter #-}+reRunIter (IterF i) = i+reRunIter r         = Iter $ runIterR r

@@ -0,0 +1,487 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- | This module contains basic iteratees and enumerators for working+-- with strings, 'LL.ListLike' objects, file handles, and stream and+-- datagram sockets.+module Data.IterIO.ListLike+    ( -- * Iteratees+      putI, sendI+    , headLI, safeHeadLI+    , headI, safeHeadI+    , lineI, safeLineI+    , dataMaxI, data0MaxI, takeI+    , handleI, sockDgramI, sockStreamI+    , stdoutI+    -- * Control requests+    , SeekMode(..)+    , SizeC(..), SeekC(..), TellC(..), fileCtl+    , GetSocketC(..), socketCtl+    -- * Onums+    , enumDgram, enumDgramFrom, enumStream+    , enumHandle, enumHandle', enumNonBinHandle+    , enumFile, enumFile'+    , enumStdin+    -- * Inums+    , inumMax, inumTakeExact+    , inumLog, inumhLog, inumStderr+    , inumLtoS, inumStoL+    -- * Functions for Iter-Inum pairs+    , pairFinalizer, iterHandle, iterStream+    ) where++import Prelude hiding (null)+import Control.Concurrent+import Control.Exception (onException)+import Control.Monad+import Control.Monad.Trans+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+    (defaultChunkSize, chunk, ByteString(..))+import Data.Char+import Data.Monoid+import Data.Typeable+import Network.Socket+import System.IO++import qualified Data.ListLike as LL++import Data.IterIO.Iter+import Data.IterIO.Inum+import Data.IterIO.Extra+++echr :: (Enum e) => Char -> e+echr = toEnum . ord++--+-- Iters+--++-- | An Iteratee that puts data to a consumer function, then calls an+-- eof function.  For instance, @'handleI'@ could be defined as:+--+-- @+-- handleI :: (MonadIO m) => 'Handle' -> 'Iter' 'L.ByteString' m ()+-- handleI h = putI ('liftIO' . 'L.hPut' h) ('liftIO' $ 'hShutdown' h 1)+-- @+putI :: (ChunkData t, Monad m) =>+        (t -> Iter t m a)+     -> Iter t m b+     -> Iter t m ()+putI putfn eoffn = doput `finallyI` eoffn+    where doput = do Chunk t eof <- chunkI+                     unless (null t) $ putfn t >> return ()+                     if eof then return () else doput++-- | Send datagrams using a supplied function.  The datagrams are fed+-- as a list of packets, where each element of the list should be a+-- separate datagram.  For example, to create an 'Iter' from a+-- connected UDP socket:+--+-- @+-- udpI :: ('SendRecvString' s, 'MonadIO' m) => 'Socket' -> 'Iter' s m ()+-- udpI sock = sendI $ 'liftIO' . 'genSend' sock+-- @+sendI :: (Show t, Monad m) =>+         (t -> Iter [t] m a)+      -> Iter [t] m ()+sendI sendfn = do+  dgram <- safeHeadI+  case dgram of+    Just pkt -> sendfn pkt >> sendI sendfn+    Nothing  -> return ()++-- | Return the first element when the Iteratee data type is a list.+headLI :: (Show a, Monad m) => Iter [a] m a+{-# INLINABLE headLI #-}+headLI = iterF dohead+    where dohead (Chunk (a:as) eof) = Done a $ Chunk as eof+          dohead c = Fail err Nothing $ Just c+          err = mkIterEOF "headLI"++-- | Return 'Just' the first element when the Iteratee data type+-- is a list, or 'Nothing' on EOF.+safeHeadLI :: (Show a, Monad m) => Iter [a] m (Maybe a)+{-# INLINABLE safeHeadLI #-}+safeHeadLI = iterF $ dohead+    where dohead (Chunk (a:as) eof) = Done (Just a) $ Chunk as eof+          dohead _                  = Done Nothing chunkEOF+++-- | Like 'headLI', but works for any 'LL.ListLike' data type.+headI :: (ChunkData t, LL.ListLike t e, Monad m) => Iter t m e+{-# INLINABLE headI #-}+headI = iterF $ \c@(Chunk t eof) ->+        if LL.null t then Fail err Nothing $ Just c+                     else Done (LL.head t) $ Chunk (LL.tail t) eof+    where err = mkIterEOF "headI"++-- | Like 'safeHeadLI', but works for any 'LL.ListLike' data type.+safeHeadI :: (ChunkData t, LL.ListLike t e, Monad m) => Iter t m (Maybe e)+{-# INLINABLE safeHeadI #-}+safeHeadI = iterF $ \c@(Chunk t eof) ->+            if LL.null t then Done Nothing c+                         else Done (Just $ LL.head t) $ Chunk (LL.tail t) eof++-- | Like 'lineI', but returns 'Nothing' on EOF.+safeLineI :: (ChunkData t, Monad m, LL.ListLike t e, Eq t, Enum e, Eq e) =>+             Iter t m (Maybe t)+safeLineI = iterF $ doline LL.empty+    where+      cr = LL.singleton $ echr '\r'+      nl = LL.singleton $ echr '\n'+      crnl = LL.append cr nl+      eol c = c == echr '\n' || c == echr '\r'+      doline acc (Chunk t eof) =+          let acc' = LL.append acc t+              (l, r) = LL.break eol acc'+              result = dolr eof l r+          in case result of+               Just (l', r') -> Done (Just l') (Chunk r' eof)+               Nothing | eof -> Done Nothing (Chunk acc' True)+               _             -> IterF $ iterF $ doline acc'+      dolr eof l r+          | LL.isPrefixOf nl r = Just (l, LL.drop (LL.length nl) r)+          | LL.isPrefixOf crnl r = Just (l, LL.drop (LL.length crnl) r)+          | LL.isPrefixOf cr r && (eof || r /= cr) =+              Just (l, LL.drop (LL.length cr) r)+          | otherwise = Nothing++-- | Return a line delimited by \\r, \\n, or \\r\\n.+lineI :: (Monad m, ChunkData t, LL.ListLike t e, Eq t, Enum e, Eq e) =>+         Iter t m t+lineI = do+  mline <- safeLineI+  case mline of+    Nothing -> throwEOFI "lineI"+    Just line -> return line++-- | Return 'LL.ListLike' data that is at most the number of elements+-- specified by the first argument, and at least one element unless+-- EOF is encountered or 0 elements are requested, in which case+-- 'mempty' is returned.+data0MaxI :: (ChunkData t, LL.ListLike t e, Monad m) => Int -> Iter t m t+data0MaxI maxlen | maxlen <= 0 = return mempty+                 | otherwise   = iterF $ \(Chunk s eof) ->+                                 case LL.splitAt maxlen s of+                                   (h, t) -> Done h $ Chunk t eof++-- | Return 'LL.ListLike' data that is at most the number of elements+-- specified by the first argument, and at least one element (as long+-- as a positive number is requested).  Throws an exception if a+-- positive number of items is requested and an EOF is encountered.+dataMaxI :: (ChunkData t, LL.ListLike t e, Monad m) => Int -> Iter t m t+dataMaxI maxlen | maxlen <= 0 = return mempty+                | otherwise   = iterF $ \c@(Chunk s eof) ->+                                if LL.null s then Fail err Nothing $ Just c+                                else case LL.splitAt maxlen s of+                                       (h, t) -> Done h $ Chunk t eof+    where err = mkIterEOF "dataMaxI"++-- | Return the next @len@ elements of a 'LL.ListLike' data stream,+-- unless an EOF is encountered, in which case fewer may be returned.+-- Note the difference from 'data0MaxI':  @'takeI' n@ will keep+-- reading input until it has accumulated @n@ elements or seen an EOF,+-- then return the data; @'data0MaxI' n@ will keep reading only until+-- it has received any non-empty amount of data, even if the amount+-- received is less than @n@ elements and there is no EOF.+takeI :: (ChunkData t, LL.ListLike t e, Monad m) => Int -> Iter t m t+takeI len | len <= 0  = return mempty+          | otherwise = do+  t <- data0MaxI len+  let tlen = LL.length t+  if tlen == len || tlen == 0+    then return t+    else LL.append t `liftM` takeI (len - tlen)++-- | Puts strings (or 'LL.ListLikeIO' data) to a file 'Handle', then+-- writes an EOF to the handle.+--+-- Note that this does not put the handle into binary mode.  To do+-- this, you may need to call @'hSetBinaryMode' h 'True'@ on the+-- handle before using it with @handleI@.  Otherwise, Haskell by+-- default will treat the data as UTF-8.  (On the other hand, if the+-- 'Handle' corresponds to a socket and the socket is being read in+-- another thread, calling 'hSetBinaryMode' can cause deadlock, so in+-- this case it is better to have the thread handling reads call+-- 'hSetBinaryMode'.)+--+-- Also note that Haskell by default buffers data written to+-- 'Handle's.  For many network protocols this is a problem.  Don't+-- forget to call @'hSetBuffering' h 'NoBuffering'@ before passing a+-- handle to 'handleI'.+handleI :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+           Handle+        -> Iter t m ()+handleI h = putI (liftIO . LL.hPutStr h) (liftIO $ hShutdown h 1)++-- | Sends a list of packets to a datagram socket.+sockDgramI :: (MonadIO m, SendRecvString t) =>+              Socket+           -> Maybe SockAddr+           -> Iter [t] m ()+sockDgramI s mdest = loop+    where sendit = case mdest of Nothing   -> liftIO . genSend s+                                 Just dest -> liftIO . flip (genSendTo s) dest+          loop = safeHeadI >>= maybe (return ()) (\str -> sendit str >> loop)++-- | Sends output to a stream socket.  Calls shutdown (e.g., to send a+-- TCP FIN packet) upon receiving EOF.+sockStreamI :: (ChunkData t, SendRecvString t, MonadIO m) =>+               Socket -> Iter t m ()+sockStreamI sock = putI (liftIO . genSend sock)+                   (liftIO $ shutdown sock ShutdownSend)++-- | An 'Iter' that uses 'LL.hPutStr' to write all output to 'stdout'.+stdoutI :: (LL.ListLikeIO t e, ChunkData t, MonadIO m) => Iter t m ()+stdoutI = putI (liftIO . LL.hPutStr stdout) (return ())++--+-- Control functions+--++-- | A control command (issued with @'ctlI' SizeC@) requesting the+-- size of the current file being enumerated.+data SizeC = SizeC deriving (Typeable)+instance CtlCmd SizeC Integer++-- | A control command for seeking within a file, when a file is being+-- enumerated.  Flushes the residual input data.+data SeekC = SeekC !SeekMode !Integer deriving (Typeable)+instance CtlCmd SeekC ()++-- | A control command for determining the current offset within a+-- file.  Note that this subtracts the size of the residual input data+-- from the offset in the file.  Thus, it will only be accurate when+-- all left-over input data is from the current file.+data TellC = TellC deriving (Typeable)+instance CtlCmd TellC Integer++-- | A handler function for the 'SizeC', 'SeekC', and 'TellC' control+-- requests.  @fileCtl@ is used internally by 'enumFile' and+-- 'enumHandle', and is exposed for similar enumerators to use.+fileCtl :: (ChunkData t, LL.ListLike t e, MonadIO m) =>+           Handle+        -> CtlHandler (Iter () m) t m a+fileCtl h = (mkFlushCtl $ \(SeekC mode pos) -> liftIO (hSeek h mode pos))+            `consCtl` tryTellC+            `consCtl` (mkCtl $ \SizeC -> liftIO (hFileSize h))+            `consCtl` passCtl id+    where tryTellC TellC n c@(Chunk t _) = do+            offset <- liftIO $ hTell h+            return $ runIter (n $ offset - LL.genericLength t) c++-- | A control request that returns the 'Socket' from an enclosing+-- socket enumerator.+data GetSocketC = GetSocketC deriving (Typeable)+instance CtlCmd GetSocketC Socket++-- | A handler for the 'GetSocketC' control request.+socketCtl :: (ChunkData t, MonadIO m) =>+             Socket -> CtlHandler (Iter () m) t m a+socketCtl s = (mkCtl $ \GetSocketC -> return s)+              `consCtl` passCtl id++--+-- Onums+--++-- | Read datagrams (of up to 64KiB in size) from a socket and feed a+-- list of strings (one for each datagram) into an Iteratee.+enumDgram :: (MonadIO m, SendRecvString t) =>+             Socket+          -> Onum [t] m a+enumDgram sock = mkInumC id (socketCtl sock) $+                 liftIO $ liftM (: []) $ genRecv sock 0x10000++-- | Read datagrams from a socket and feed a list of (Bytestring,+-- SockAddr) pairs (one for each datagram) into an Iteratee.+enumDgramFrom :: (MonadIO m, SendRecvString t) =>+                 Socket+              -> Onum [(t, SockAddr)] m a+enumDgramFrom sock = mkInumC id (socketCtl sock) $+                     liftIO $ liftM (: []) $ genRecvFrom sock 0x10000++-- | Read data from a stream (e.g., TCP) socket.+enumStream :: (MonadIO m, ChunkData t, SendRecvString t) =>+              Socket -> Onum t m a+enumStream sock = mkInumC id (socketCtl sock) $+                  liftIO (genRecv sock L.defaultChunkSize)++-- | A variant of 'enumHandle' type restricted to input in the Lazy+-- 'L.ByteString' format.+enumHandle' :: (MonadIO m) => Handle -> Onum L.ByteString m a+enumHandle' = enumHandle++-- | Puts a handle into binary mode with 'hSetBinaryMode', then+-- enumerates data read from the handle to feed an 'Iter' with any+-- 'LL.ListLikeIO' input type.+enumHandle :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+              Handle+           -> Onum t m a+enumHandle h iter = tryFI (liftIO $ hSetBinaryMode h True) >>= check+    where check (Left e)  = Iter $ Fail e (Just $ IterF iter) . Just+          check (Right _) = enumNonBinHandle h iter++-- | Feeds an 'Iter' with data from a file handle, using any input+-- type in the 'LL.ListLikeIO' class.  Note that @enumNonBinHandle@+-- uses the handle as is, unlike 'enumHandle', and so can be used if+-- you want to read the data in non-binary form.+enumNonBinHandle :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+                    Handle+                 -> Onum t m a+enumNonBinHandle h =+    mkInumC id (fileCtl h) $+    liftIO (hWaitForInput h (-1) >> LL.hGetNonBlocking h L.defaultChunkSize)+-- Note that hGet can block when there is some (but not enough) data+-- available.  Thus, we use hWaitForInput followed by hGetNonBlocking.+-- ByteString introduced the call hGetSome for this purpose, but it is+-- not supported by the ListLike package yet.++-- | Enumerate the contents of a file as a series of lazy+-- 'L.ByteString's.  (This is a type-restricted version of+-- 'enumFile'.)+enumFile' :: (MonadIO m) => FilePath -> Onum L.ByteString m a+enumFile' = enumFile++-- | Enumerate the contents of a file for an 'Iter' taking input in+-- any 'LL.ListLikeIO' type.  Note that the file is opened with+-- 'openBinaryFile' to ensure binary mode.+enumFile :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+            FilePath -> Onum t m a+enumFile path = inumBracket (liftIO $ openBinaryFile path ReadMode)+                (liftIO . hClose) enumNonBinHandle++-- | Enumerate standard input.+enumStdin :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) => Onum t m a+enumStdin = enumHandle stdin++--+-- Inums+--++-- | Feed exactly some number of bytes to an 'Iter'.  Throws an error+-- if that many bytes are not available.+inumTakeExact :: (ChunkData t, LL.ListLike t e, Monad m) => Int -> Inum t t m a+inumTakeExact = mkInumM . loop+    where loop n | n <= 0    = return ()+                 | otherwise = do+            t <- dataI+            let (h, r) = LL.splitAt n t+            ungetI r+            _ <- ifeed h        -- Keep feeding even if Done+            loop $ n - LL.length h++-- | Feed up to some number of list elements (bytes in the case of+-- 'L.ByteString's) to an 'Iter', or feed fewer if the 'Iter' returns+-- or an EOF is encountered.  The formulation @inumMax n '.|' iter@+-- can be used to prevent @iter@ from consuming unbounded amounts of+-- input.+inumMax :: (ChunkData t, LL.ListLike t e, Monad m) => Int -> Inum t t m a+{-# SPECIALIZE inumMax :: (Monad m) =>+  Int -> Inum L.ByteString L.ByteString m a #-}+{-# SPECIALIZE inumMax :: (Monad m) =>+  Int -> Inum S.ByteString S.ByteString m a #-}+inumMax n0 i | n0 <= 0 = runner i mempty+             | otherwise = do+  (t, more) <- next n0+  r <- runner i $ chunk t+  case r of+    IterF i1 | more -> inumMax (n0 - LL.length t) i1+    _ | isIterActive r -> return r+    _ -> case getResid r of+           Chunk t1 _ -> ungetI t1 >> return (setResid r mempty) +    where runner = runIterMC (passCtl pullupResid)+          next n = Iter $ \(Chunk t eof) ->+                   case LL.splitAt n t of+                     (t1, t2) -> Done (t1, not eof && LL.null t2) (Chunk t2 eof)+                   +-- | This inner enumerator is like 'inumNop' in that it passes+-- unmodified 'Chunk's straight through to an iteratee.  However, it+-- also logs the 'Chunk's to a file (which can optionally be truncated+-- or appended to, based on the second argument).+inumLog :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+           FilePath             -- ^ Path to log to+        -> Bool                 -- ^ True to truncate file+        -> Inum t t m a+inumLog path trunc = inumBracket openLog (liftIO . hClose) inumhLog+    where openLog = liftIO $ do+            h <- openBinaryFile path (if trunc then WriteMode else AppendMode)+            hSetBuffering h NoBuffering+            return h++-- | Like 'inumLog', but takes a writeable file handle rather than a+-- file name.  Does not close the handle when done.+inumhLog :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+            Handle -> Inum t t m a+inumhLog h = mkInumP pullupResid $ do+               buf <- data0I+               unless (null buf) $ liftIO $ LL.hPutStr h buf+               return buf++-- | Log a copy of everything to standard error.  (@inumStderr =+-- 'inumhLog' 'stderr'@)+inumStderr :: (MonadIO m, ChunkData t, LL.ListLikeIO t e) =>+              Inum t t m a+inumStderr = inumhLog stderr++-- | An 'Inum' that converts input in the lazy 'L.ByteString' format+-- to strict 'S.ByteString's.+inumLtoS :: (Monad m) => Inum L.ByteString S.ByteString m a+{-# INLINABLE inumLtoS #-}+inumLtoS = mkInumP rh loop+    where rh (a, b) = (L.chunk b a, S.empty)+          loop = iterF $ \c@(Chunk lbs eof) ->+                 case lbs of+                   L.Chunk bs rest -> Done bs (Chunk rest eof)+                   _               -> Done S.empty c++-- | The dual of 'inumLtoS'--converts input from strict+-- 'S.ByteString's to lazy 'L.ByteString's.+inumStoL :: (Monad m) => Inum S.ByteString L.ByteString m a+inumStoL = mkInumP rh loop+    where rh (a, b) = (S.concat (L.toChunks b ++ [a]), L.empty)+          loop = iterF $ \(Chunk bs eof) ->+                 Done (L.chunk bs L.Empty) (Chunk S.empty eof)++--+-- Iter-Onum pairs+--++-- | Add a finalizer to run when an 'Iter' has received an EOF and an+-- 'Inum' has finished.  This works regardless of the order in which+-- the two events happen.+pairFinalizer :: (ChunkData t, ChunkData t1, ChunkData t2+                 , MonadIO m, MonadIO m1) =>+                 Iter t m a+              -> Inum t1 t2 m1 b+              -> IO ()+              -- ^ Cleanup action+              -> IO (Iter t m a, Inum t1 t2 m1 b)+              -- ^ Cleanup action will run when these two are both done+pairFinalizer iter inum cleanup = do+  mc <- newMVar False+  let end = modifyMVar mc $ \cleanit ->+            when cleanit cleanup >> return (True, ())+  return (iter `finallyI` liftIO end+         , (inumNull `cat` inum) `inumFinally` liftIO end)++-- | \"Iterizes\" a file 'Handle' by turning into an 'Onum' (for+-- 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.+iterHandle :: (LL.ListLikeIO t e, ChunkData t, MonadIO m) =>+              Handle -> IO (Iter t m (), Onum t m a)+iterHandle h = do+  hSetBinaryMode h True `onException` hClose h+  pairFinalizer (handleI h) (enumNonBinHandle h) (hClose h)++-- | \"Iterizes\" a stream 'Socket' by turning into an 'Onum' (for+-- reading) and an 'Iter' (for writing).  Uses 'pairFinalizer' to+-- 'sClose' the 'Socket' when both the 'Iter' and 'Onum' are finished.+iterStream :: (SendRecvString t, ChunkData t, MonadIO m) =>+              Socket -> IO (Iter t m (), Onum t m a)+iterStream s = pairFinalizer (sockStreamI s) (enumStream s) (sClose s)

@@ -0,0 +1,561 @@++-- | This module contains functions to help parsing input from within+-- 'Iter's.  Many of the operators are either imported from+-- "Data.Applicative" or inspired by "Text.Parsec".++module Data.IterIO.Parse (-- * Iteratee combinators+                          (<|>), (\/), orEmpty, (<?>), expectedI+                         , someI, foldrI, foldr1I, foldrMinMaxI+                         , foldlI, foldl1I, foldMI, foldM1I+                         , skipI, optionalI, ensureI+                         , eord+                         , skipWhileI, skipWhile1I+                         , whileI, while1I, whileMaxI, whileMinMaxI+                         , concatI, concat1I, concatMinMaxI+                         , readI, eofI+                         -- * Applicative combinators+                         , (<$>), (<$), ($>), (>$>), Applicative(..), (<**>)+                         , (<++>), (<:>), nil+                         -- * Parsing Iteratees+                         -- $Parseclike+                         , many, skipMany, sepBy, endBy, sepEndBy+                         , many1, skipMany1, sepBy1, endBy1, sepEndBy1+                         , satisfy, char, match, string, stringCase+                         ) where++import Prelude hiding (null)+import Control.Applicative (Applicative(..), (<**>), liftA2)+import Control.Monad+import Data.Char+import Data.Functor ((<$>), (<$))+import qualified Data.ListLike as LL+import Data.Monoid++import Data.IterIO.Iter+import Data.IterIO.Inum+import Data.IterIO.ListLike++-- | An infix synonym for 'multiParse' that allows LL(*) parsing of+-- alternatives by executing both Iteratees on input chunks as they+-- arrive.  This is similar to the @\<|>@ method of the+-- @'Alternative'@ class in "Control.Applicative", but the+-- @'Alternative'@ operator has left fixity, while for efficiency this+-- one has:+--+-- > infixr 3 <|>+(<|>) :: (ChunkData t, Monad m) =>+         Iter t m a -> Iter t m a -> Iter t m a+{-# INLINE (<|>) #-}+(<|>) = multiParse+infixr 3 <|>++-- | An infix synonym for 'ifNoParse' that allows LL(*) parsing of+-- alternatives by keeping a copy of input data consumed by the first+-- Iteratee so as to backtrack and execute the second Iteratee if the+-- first one fails.  Returns a function that takes a continuation for+-- the first 'Iter', should it succeed.  The code:+--+-- >     iter1 \/ iter2 $ \iter1Result -> doSomethingWith iter1Result+--+-- Executes @iter1@ (saving a copy of the input for backtracking).  If+-- @iter1@ fails with an exception of class 'IterNoParse', then the+-- input is re-wound and fed to @iter2@.  On the other hand, if+-- @iter1@ succeeds and returns @iter1Result@, then the saved input is+-- discarded (as @iter2@ will not need to be run) and the result of+-- @iter1@ is fed to function @doSomethingWith@.+--+-- For example, to build up a list of results of executing @iter@, one+-- could implement a type-restricted version of 'many' as follows:+--+-- @+--   myMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m [a]+--   myMany iter = iter \\/ return [] '$' \\r -> 'fmap' ((:) r) (myMany iter)+-- @+--+-- In other words, @myMany@ tries running @iter@.  If @iter@ fails,+-- then @myMany@ returns the empty list.  If @iter@ succeeds, its+-- result @r@ is added to the head of the list returned by calling+-- @myMany@ recursively.  This idiom of partially applying a binary+-- funciton to a result and then applying the resulting function to an+-- 'Iter' via 'fmap' is so common that there is an infix operator for+-- it, @'>$>'@.  Thus, the above code can be written:+--+-- @+--   myMany iter = iter \\/ return [] '$' (:) '>$>' myMany iter+-- @+--+-- Of course, using 'fmap' is not the most efficient way to implement+-- @myMany@.  If you are going to use this pattern for something+-- performance critical, you should use an accumulator rather than+-- build up long chains of 'fmap's.  A faster implementation would be:+--+-- @+--   myMany iter = loop id+--       where loop ac = iter \\/ return (acc []) '$' \a -> loop (acc . (a :))+-- @+--+-- @\\/@ has fixity:+--+-- > infix 2 \/+--+(\/) :: (ChunkData t, Monad m) => +        Iter t m a -> Iter t m b -> (a -> Iter t m b) -> Iter t m b+{-# INLINE (\/) #-}+(\/) = ifNoParse+infix 2 \/++-- | @(f >$> a) t@ is equivalent to @f t '<$>' a@ (where '<$>' is and+-- infix alias for 'fmap').  Particularly useful with infix+-- combinators such as '\/' and ``orEmpty`` when chaining parse+-- actions.  See examples at '\/' and 'orEmpty'.  Note 'fmap' is not+-- always the most efficient solution (see an example in the+-- description of '\/').+--+-- Has fixity:+--+-- > infixl 3 >$>+--+(>$>) :: (Functor f) => (t -> a -> b) -> f a -> t -> f b+{-# INLINE (>$>) #-}+(>$>) f a = \t -> f t <$> a+infixr 3 >$>++-- | @fa $> b = b <$ fa@ -- replaces the output value of a functor+-- with some pure value.  Has the same fixity as '<$>' and '<$',+-- namely:+--+-- > infixl 4 $>+($>) :: (Functor f) => f a -> b -> f b+{-# INLINE ($>) #-}+a $> b = b <$ a+infixl 4 $>++-- | Defined as @orEmpty = ('\/' return 'mempty')@, and useful when+-- parse failures should just return an empty 'Monoid'.  For example,+-- a type-restricted 'many' can be implemented as:+--+-- @+--   myMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m [a]+--   myMany iter = iter ``orEmpty`` (:) '>$>' myMany iter+-- @+--+-- Has fixity:+--+-- > infixr 3 `orEmpty`+--+orEmpty :: (ChunkData t, Monad m, Monoid b) =>+           Iter t m a -> (a -> Iter t m b) -> Iter t m b+{-# INLINE orEmpty #-}+orEmpty = (\/ nil)+infixr 3 `orEmpty`++-- | @iter \<?\> token@ replaces any kind of parse failure in @iter@+-- with an exception equivalent to calling @'expectedI' prefix token@+-- where @prefix@ is a prefix of the input that was fed to @iter@ and+-- caused it to fail.+--+-- Has fixity:+--+-- > infix 0 <?>+--+(<?>) :: (ChunkData t, Monad m) => Iter t m a -> String -> Iter t m a+{-# INLINE (<?>) #-}+(<?>) iter expected =+    Iter $ \c -> case runIter iter c of+      r@(Done _ _)   -> r+      r@(Fail e _ _) -> case e of+                          IterException _ -> r+                          _ -> Fail (IterExpected [(show c, expected)])+                                    Nothing Nothing+      r              -> slowPath (show c) expected r+    where+      {-# NOINLINE slowPath #-}+      slowPath saw exp1 = onDoneR $ \r0 ->+        case r0 of+          r@(Fail e _ _) -> case e of+                              IterException _ -> r+                              _ -> Fail (IterExpected [(saw, exp1)])+                                   Nothing Nothing+          r -> r+infix 0 <?>+  +-- | Throw an 'Iter' exception that describes expected input not+-- found.+expectedI :: (ChunkData t) =>+             String             -- ^ Input actually received+          -> String             -- ^ Description of input that was wanted+          -> 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.+foldrI :: (ChunkData t, Monad m) =>+          (a -> b -> b) -> b -> Iter t m a -> Iter t m b+foldrI = innerFoldrI id++innerFoldrI :: (ChunkData t, Monad m) =>+               (b -> b) -> (a -> b -> b) -> b -> Iter t m a -> Iter t m b+innerFoldrI acc0 f z iter = loop acc0+    where loop acc = iter \/ return (acc z) $ \a -> loop (acc . f a)++-- | A variant of 'foldrI' that requires the 'Iter' to succeed at+-- least once.+foldr1I :: (ChunkData t, Monad m) =>+           (a -> b -> b) -> b -> Iter t m a -> Iter t m b+foldr1I f z iter = iter >>= \a -> innerFoldrI (f a) f z iter++-- | A variant of 'foldrI' that requires the 'Iter' to succeed at+-- least a minimum number of items and stops parsing after executing+-- the 'Iter' some maximum number of times.+foldrMinMaxI :: (ChunkData t, Monad m) =>+                Int             -- ^ Minimum number to parse+             -> Int             -- ^ Maximum number to parse+             -> (a -> b -> b)   -- ^ Folding function+             -> b               -- ^ Rightmost value+             -> Iter t m a      -- ^ Iteratee generating items to fold+             -> Iter t m b+foldrMinMaxI nmin0 nmax0 f z iter+    | nmin0 > nmax0 = throwParseI "foldrMinMaxI: min > max"+    | nmax0 < 0     = throwParseI "foldrMinMaxI: negative max"+    | otherwise = loop id nmin0 nmax0+    where+      loop acc nmin nmax+          | nmax == 0 = return $ acc z+          | nmin > 0  = iter >>= \a -> loop (acc . f a) (nmin - 1) (nmax - 1)+          | otherwise = iter \/ return (acc z) $ \a ->+                        loop (acc . f a) 0 (nmax - 1)++-- | Strict left fold over an 'Iter' (until it throws an 'IterNoParse'+-- exception).  @foldlI f z iter@ is sort of equivalent to:+--+-- > ... (f <$> (f <$> (f z <$> iter) <*> iter) <*> iter) ...+foldlI :: (ChunkData t, Monad m) =>+          (b -> a -> b) -> b -> Iter t m a -> Iter t m b+foldlI f z0 iter = foldNext z0+    where foldNext z = z `seq` iter \/ return z $ \a -> foldNext (f z a)++-- | A version of 'foldlI' that fails if the 'Iter' argument does not+-- succeed at least once.+foldl1I :: (ChunkData t, Monad m) =>+           (b -> a -> b) -> b -> Iter t m a -> Iter t m b+foldl1I f z iter = iter >>= \a -> foldlI f (f z a) iter++-- | @foldMI@ is a left fold in which the folding function can execute+-- monadic actions.  Essentially @foldMI@ is to 'foldlI' as 'foldM' is+-- to @`foldl'`@ in the standard libraries.+foldMI :: (ChunkData t, Monad m) =>+          (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m b+foldMI f z0 iter = foldNext z0+    where foldNext z = iter \/ return z $ f z >=> foldNext++-- | A variant of 'foldMI' that requires the 'Iter' to succeed at+-- least once.+foldM1I :: (ChunkData t, Monad m) =>+           (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m b+foldM1I f z0 iter = iter >>= f z0 >>= \z -> foldMI f z iter+++-- | Discard the result of executing an Iteratee once.  Throws an+-- error if the Iteratee fails.  (Like @skip x = x >> return ()@.)+skipI :: Applicative f => f a -> f ()+skipI = (() <$)++-- | Execute an iteratee.  Discard the result if it succeeds.  Rewind+-- the input and suppress the error if it fails.+optionalI :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()+optionalI iter = ifParse iter (const $ return ()) (return ())++-- | Ensures the next input element satisfies a predicate or throws a+-- parse error.  Does not consume any input.+ensureI :: (ChunkData t, LL.ListLike t e, Monad m) =>+           (e -> Bool) -> Iter t m ()+ensureI test =+    Iter $ \c@(Chunk t eof) ->+        if LL.null t+           then (if eof then eofFail else IterF (ensureI test))+           else (if test (LL.head t) then Done () c else testFail)+    where testFail = Fail (IterParseErr "ensureI test failed") Nothing Nothing+          eofFail  = Fail (mkIterEOF "ensureI EOF") Nothing Nothing++-- | A variant of the standard library 'ord' function, but that+-- translates a 'Char' into any 'Enum' type, not just 'Int'.+-- Particularly useful for 'Iter's that must work with both 'String's+-- (which consist of 'Char's) and ASCII @'ByteString'@s (which consist+-- of @'Word8'@s).  For example, to skip one or more space or TAB+-- characters, you can use:+--+-- @+--   skipSpace :: ('LL.ListLike' t e, ChunkData t, 'Eq' e, 'Enum' e, Monad m) =>+--                'Iter' t m ()+--   skipSpace = 'skipWhile1I' (\\c -> c == eord ' ' || c == eord '\t')+-- @+eord :: (Enum e) => Char -> e+{-# INLINE eord #-}+eord = toEnum . ord++-- | Skip all input elements encountered until an element is found+-- that does not match the specified predicate.+skipWhileI :: (ChunkData t, LL.ListLike t e, Monad m) =>+              (e -> Bool) -> Iter t m ()+skipWhileI test = loop+    where loop = Iter $ \(Chunk t eof) ->+                 case LL.dropWhile test t of+                   t1 | LL.null t1 && not eof -> IterF loop+                   t1 -> Done () $ Chunk t1 eof++-- | Like 'skipWhileI', but fails if at least one element does not+-- satisfy the predicate.+skipWhile1I :: (ChunkData t, LL.ListLike t e, Monad m) =>+               (e -> Bool) -> Iter t m ()+skipWhile1I test = ensureI test >> skipWhileI test <?> "skipWhile1I"++-- | Return all input elements up to the first one that does not match+-- the specified predicate.+whileI :: (ChunkData t, LL.ListLike t e, Monad m)+          => (e -> Bool) -> Iter t m t+whileI test = more id+    where+      more acc = Iter $ \(Chunk t eof) ->+                 case LL.span test t of+                   (t1, t2) | not (LL.null t2) || eof ->+                                     Done (acc t1) $ Chunk t2 eof+                   (t1, _) -> IterF $ more (acc . LL.append t1)++-- | Like 'whileI', but fails if at least one element does not satisfy+-- the predicate.+while1I :: (ChunkData t, LL.ListLike t e, Monad m) =>+           (e -> Bool) -> Iter t m t+while1I test = ensureI test >> whileI test++-- | A variant of 'whileI' with a maximum number matches.+whileMaxI :: (ChunkData t, LL.ListLike t e, Monad m) =>+             Int                  -- ^ Maximum number to match+          -> (e -> Bool)          -- ^ Predicate test+          -> Iter t m t+whileMaxI nmax test = inumMax nmax .| whileI test++-- | A variant of 'whileI' with a minimum and maximum number matches.+whileMinMaxI :: (ChunkData t, LL.ListLike t e, Monad m) =>+                Int                  -- ^ Minumum number+             -> Int                  -- ^ Maximum number+             -> (e -> Bool)          -- ^ Predicate test+             -> Iter t m t+whileMinMaxI nmin nmax test = do+  result <- whileMaxI nmax test+  if LL.length result >= nmin+    then return result+    else expectedI "too few" "whileMinMaxI minimum"++-- | Repeatedly execute an 'Iter' returning a 'Monoid' and 'mappend'+-- all the results in a right fold.+concatI :: (ChunkData t, Monoid s, Monad m) =>+           Iter t m s -> Iter t m s+concatI iter = foldrI mappend mempty iter++-- | Like 'concatI', but fails if the 'Iter' doesn't return at least+-- once.+concat1I :: (ChunkData t, Monoid s, Monad m) =>+           Iter t m s -> Iter t m s+concat1I iter = foldr1I mappend mempty iter++-- | A version of 'concatI' that takes a minimum and maximum number of+-- items to parse.+concatMinMaxI :: (ChunkData t, Monoid s, Monad m) =>+                 Int            -- ^ Minimum number to parse+              -> Int            -- ^ Maximum number to parse+              -> Iter t m s     -- ^ 'Iter' whose results to concatenate+              -> Iter t m s+concatMinMaxI nmin nmax iter = foldrMinMaxI nmin nmax mappend mempty iter+                               +                               +-- | This 'Iter' parses a 'LL.StringLike' argument.  It does not+-- consume any Iteratee input.  The only reason it is an Iteratee is+-- so that it can throw an Iteratee parse error should it fail to+-- parse the argument string (or should the argument yield an+-- ambiguous parse).+readI :: (ChunkData t, Monad m, LL.StringLike s, Read a) => +         s -> Iter t m a+readI s' = let s = LL.toString s'+           in case [a | (a,"") <- reads s] of+                [a] -> return a+                []  -> throwParseI $ "readI can't parse: " ++ s+                _   -> throwParseI $ "readI ambiguous: " ++ s++-- | Ensures the input is at the end-of-file marker, or else throws an+-- exception.+eofI :: (ChunkData t, Monad m, Show t) => Iter t m ()+eofI = do+  Chunk t eof <- iterF $ \c -> Done c c+  if eof && null t+    then return ()+    else expectedI (chunkShow t) "EOF"++-- | 'mappend' the result of two 'Applicative' types returning+-- 'Monoid' types (@\<++> = 'liftA2' 'mappend'@).  Has the same fixity+-- as '++', namely:+--+-- > infixr 5 <++>+(<++>) :: (Applicative f, Monoid t) => f t -> f t -> f t+(<++>) = liftA2 mappend+infixr 5 <++>++-- | 'LL.cons' an 'Applicative' type onto an an 'Applicative'+-- 'LL.ListLike' type (@\<:> = 'liftA2' 'LL.cons'@).  Has the same+-- fixity as @:@, namely:+--+-- > infixr 5 <:>+(<:>) :: (LL.ListLike t e, Applicative f) => f e -> f t -> f t+{-# INLINE (<:>) #-}+(<:>) = liftA2 LL.cons+infixr 5 <:>++-- | @nil = 'pure' 'mempty'@--An empty 'Monoid' injected into an+-- 'Applicative' type.+nil :: (Applicative f, Monoid t) => f t+{-# INLINE nil #-}+nil = pure mempty++-- $Parseclike+--+-- These functions are intended to be similar to those supplied by+-- "Text.Parsec".++-- | Run an 'Iter' zero or more times (until it fails) and return a+-- list-like container of the results.+many :: (ChunkData t, LL.ListLike f a, Monad m) => Iter t m a -> Iter t m f+{-# INLINE many #-}+many = foldrI LL.cons LL.empty++-- | Repeatedly run an 'Iter' until it fails and discard all the+-- results.+skipMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()+skipMany = foldlI (\_ _ -> ()) ()++-- | Parses a sequence of the form+-- /Item1 Separator Item2 Separator ... Separator ItemN/+-- and returns the list @[@/Item1/@,@ /Item2/@,@ ...@,@ /ItemN/@]@+-- or a 'LL.ListLike' equivalent.+sepBy :: (ChunkData t, LL.ListLike f a, Monad m) =>+         Iter t m a             -- ^ Item to parse+      -> Iter t m b             -- ^ Separator between items+      -> Iter t m f             -- ^ Returns 'LL.ListLike' list of items+sepBy item sep = item `orEmpty` \a ->+                 innerFoldrI (LL.cons a) LL.cons LL.empty (sep *> item)++-- | Like 'sepBy', but expects a separator after the final item.  In+-- other words, parses a sequence of the form+-- /Item1 Separator Item2 Separator ... Separator ItemN Separator/+-- and returns the list @[@/Item1/@,@ /Item2/@,@ ...@,@ /ItemN/@]@ or+-- a 'LL.ListLike' equivalent.+endBy :: (ChunkData t, LL.ListLike f a, Monad m) =>+         Iter t m a             -- ^ Item to parse+      -> Iter t m b             -- ^ Separator that must follow each item+      -> Iter t m f             -- ^ Returns 'LL.ListLike' list of items+endBy item sep = foldrI LL.cons LL.empty (item <* sep)++-- | Accepts items that would be parsed by either 'sepBy' or 'endBy'.+-- Essentially a version of 'endBy' in which the final separator is+-- optional.+sepEndBy :: (ChunkData t, LL.ListLike f a, Monad m) =>+            Iter t m a -> Iter t m b -> Iter t m f+sepEndBy item sep = sepBy item sep <* optionalI sep+++-- | Run an 'Iter' one or more times (until it fails) and return a+-- list-like container of the results.+many1 :: (ChunkData t, LL.ListLike f a, Monad m) => Iter t m a -> Iter t m f+many1 = foldr1I LL.cons LL.empty++-- | A variant of 'skipMany' that throws a parse error if the 'Iter'+-- does not succeed at least once.+skipMany1 :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()+skipMany1 = foldl1I (\_ _ -> ()) ()++-- | A variant of 'sepBy' that throws a parse error if it cannot+-- return at least one item.+sepBy1 :: (ChunkData t, LL.ListLike f a, Monad m) =>+          Iter t m a -> Iter t m b -> Iter t m f+sepBy1 item sep = item >>= \a ->+                  innerFoldrI (LL.cons a) LL.cons LL.empty (sep *> item)++-- | A variant of 'endBy' that throws a parse error if it cannot+-- return at least one item.+endBy1 :: (ChunkData t, LL.ListLike f a, Monad m) =>+          Iter t m a -> Iter t m b -> Iter t m f+endBy1 item sep = foldr1I LL.cons LL.empty (item <* sep)++-- | A variant of 'sepEndBy' that throws a parse error if it cannot+-- return at least one item.+sepEndBy1 :: (ChunkData t, LL.ListLike f a, Monad m) =>+             Iter t m a -> Iter t m b -> Iter t m f+sepEndBy1 item sep = sepBy1 item sep <* optionalI sep++                 +-- | Read the next input element if it satisfies some predicate.+-- Otherwise throw an error.+satisfy :: (ChunkData t, LL.ListLike t e, Enum e, Monad m) =>+           (e -> Bool) -> Iter t m e+satisfy test =+    Iter $ \c@(Chunk t eof) ->+        if LL.null t+           then (if eof then eofFail else IterF (satisfy test))+           else case LL.head t of+                  h | test h -> +                        Done h (Chunk (LL.tail t) eof)+                    | otherwise ->+                        Fail (IterExpected [(show $ chr $ fromEnum h+                                           , "satisfy predicate")])+                        Nothing (Just c)+    where eofFail  = Fail (mkIterEOF "satisfy: EOF") Nothing Nothing++-- | Read input that exactly matches a character.+char :: (ChunkData t, LL.ListLike t e, Eq e, Enum e, Monad m) =>+        Char -> Iter t m e+{-# INLINE char #-}+char target = satisfy (eord target ==) <?> show target++-- | Read input that exactly matches some target.+match :: (ChunkData t, LL.ListLike t e, Eq e, Monad m) =>+         t -> Iter t m t+match ft = doMatch ft+    where doMatch target | LL.null target = return ft+                         | otherwise      = do+            m <- data0MaxI $ LL.length target+            if not (LL.null m) && LL.isPrefixOf m target+              then doMatch $ LL.drop (LL.length m) target+              else expectedI (chunkShow m) $ chunkShow target++-- | Read input that exactly matches a string.+string :: (ChunkData t, LL.ListLike t e, LL.StringLike t, Eq e, Monad m) =>+          String -> Iter t m t+{-# INLINE string #-}+string = match . LL.fromString++-- | Read input that matches a string up to case.+stringCase :: (ChunkData t, LL.ListLike t e, Enum e, Eq e, Monad m) =>+              String -> Iter t m t+stringCase ft = doMatch LL.empty $ ft+    where+      prefix a b | LL.null a = True+                 | otherwise =+                     if toLower (chr $ fromEnum $ LL.head a) /= toLower (head b)+                     then False else LL.tail a `prefix` LL.tail b+      doMatch acc target | LL.null target = return acc+                         | otherwise      = do+        m <- data0MaxI $ LL.length target+        if not (LL.null m) && m `prefix` target+          then doMatch (LL.append acc m) $ LL.drop (LL.length m) target+          else expectedI (chunkShow m) $ chunkShow target

@@ -0,0 +1,100 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Data.IterIO.SSL where++import Control.Exception (throwIO, ErrorCall(..), finally, onException)+import Control.Monad+import Control.Monad.Trans+import Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.Internal as L (defaultChunkSize)+import Data.Typeable+import qualified Network.Socket as Net+import qualified OpenSSL.Session as SSL+import System.Cmd+import System.Exit++import Data.IterIO.Iter+import Data.IterIO.Inum+import Data.IterIO.ListLike++-- | A wrapper around the type 'SSL.SSL' to make it an instance of the+-- 'Typeable' class.+newtype SslConnection = SslConnection { unSslConnection :: SSL.SSL }+    deriving (Typeable)++-- | Control request to fetch the 'SSL' object associated with an+-- enumerator.+data SslC = SslC deriving (Typeable)+instance CtlCmd SslC SslConnection++-- | Simple OpenSSL 'Onum'.+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)+          codec = do buf <- liftIO (SSL.read ssl L.defaultChunkSize)+                     if S.null buf+                       then return L.empty+                       else return $ L.fromChunks [buf]++-- | Simple OpenSSL 'Iter'.  Does a uni-directional SSL shutdown when+-- it receives a 'Chunk' with the EOF bit 'True'.+sslI :: (MonadIO m) => SSL.SSL -> Iter L.ByteString m ()+sslI ssl = loop+    where loop = do+            Chunk t eof <- chunkI+            unless (L.null t) $ liftIO $ SSL.lazyWrite ssl t+            if eof then liftIO $ SSL.shutdown ssl SSL.Unidirectional else loop++-- | Turn a socket into an 'Iter' and 'Onum' that use OpenSSL to write+-- to and read from the socket, respectively.  Does an SSL+-- bi-directional shutdown and closes the socket when both a) the enum+-- completes and b) the iter has received an EOF chunk.+--+-- If the SSL handshake fails, then @iterSSL@ closes the socket before+-- throwing an exception.+--+-- This funciton must only be invoked from within a call to+-- @withOpenSSL@.+iterSSL :: (MonadIO m) =>+           SSL.SSLContext+        -- ^ OpenSSL context+        -> Net.Socket+        -- ^ The socket+        -> Bool+        -- ^ 'True' for server handshake, 'False' for client+        -> IO (Iter L.ByteString m (), Onum L.ByteString m a)+iterSSL ctx sock server = do+  ssl <- SSL.connection ctx sock `onException` Net.sClose sock+  (if server then SSL.accept ssl else SSL.connect ssl)+                          `onException` Net.sClose sock+  liftIO $ pairFinalizer (sslI ssl) (enumSsl ssl) $+         SSL.shutdown ssl SSL.Bidirectional `finally` Net.sClose sock++-- | Simplest possible SSL context, loads cert and unencrypted private+-- key from a single file.+simpleContext :: FilePath -> IO SSL.SSLContext+simpleContext keyfile = do+  ctx <- SSL.context+  SSL.contextSetDefaultCiphers ctx+  SSL.contextSetCertificateFile ctx keyfile+  SSL.contextSetPrivateKeyFile ctx keyfile+  -- SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer False True+  SSL.contextSetVerificationMode ctx SSL.VerifyNone+  return ctx++-- | Quick and dirty funciton to generate a self signed certificate+-- for testing and stick it in a file.  E.g.:+--+-- > genSelfSigned "testkey.pem" "localhost"+genSelfSigned :: FilePath       -- ^ Filename in which to output key+              -> String         -- ^ Common Name (usually domain name)+              -> IO ()+genSelfSigned file cn = do+  r <- rawSystem "openssl"+       [ "req", "-x509", "-nodes", "-days", "365", "-subj", "/CN=" ++ cn+       , "-newkey", "rsa:1024", "-keyout", file, "-out", file+       ]+  when (r /= ExitSuccess) $ throwIO $ ErrorCall "openssl failed"

@@ -0,0 +1,114 @@++module Data.IterIO.Search (inumStopString+                          , mapI, mapLI+                          ) where++import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteString.Lazy.Search as Search+import qualified Data.ListLike as LL+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Monoid++import Data.IterIO.Iter+import Data.IterIO.Inum++-- | Feeds input to an Iteratee until some boundary string is found.+-- The boundary string is neither consumed nor passed through to the+-- target 'Iter'.  (Thus, if the input is at end-of-file after+-- inumStopString returns, it means the boundary string was never+-- encountered.)+inumStopString :: (Monad m) =>+                  S8.ByteString+               -> Inum L8.ByteString L8.ByteString m a+inumStopString spat = mkInumM $ nextChunk L8.empty+    where+      lpat = L8.fromChunks [spat]+      plen = toEnum $ S8.length spat+      search = Search.breakOn spat+      nextChunk old = do+        (Chunk t eof) <- chunkI+        case search $ L8.append old t of+          (a, b) | not (L8.null b) -> ungetI b >> ifeed a+          (a, _) | eof             -> ifeed a+          (a, _)                   -> checkEnd a+      checkEnd t = let tlen = L8.length t+                       hlen = max 0 (tlen - plen - 1)+                       ttail = L8.drop hlen t+                       fpm = firstPossibleMatch 0 ttail+                       rlen = hlen + fpm+                   in if rlen == tlen+                      then ifeed t >> nextChunk L8.empty+                      else case L8.splitAt rlen t of+                             (r, o) -> ifeed r >> nextChunk o+      firstPossibleMatch n t =+          if t `L8.isPrefixOf` lpat+          then n+          else firstPossibleMatch (n + 1) (L8.tail t)++longestCommonPrefix :: (LL.ListLike t e, Eq e) => t -> t -> t+longestCommonPrefix a0 = cmp 0 a0+    where+      cmp n a b | LL.null a || LL.null b = LL.take n a0+      cmp n a b | LL.head a == LL.head b = cmp (n + 1) (LL.tail a) (LL.tail b)+      cmp n _ _                          = LL.take n a0++findLongestPrefix :: (LL.ListLike t e, Ord t, Eq e) =>+                     Map t a -> t -> Maybe (t, a)+findLongestPrefix mp t = maybe ckprefix (\v1 -> Just (t, v1)) ma+    where+      (ltmap, ma, _) = Map.splitLookup t mp+      (k, v) = Map.findMax ltmap+      p = longestCommonPrefix k t+      ckprefix | Map.null mp || LL.null t = Nothing+               | k `LL.isPrefixOf` t      = Just (k, v)+               | otherwise                = findLongestPrefix ltmap p++-- | Reads input until it can uniquely determine the longest key in a+-- 'Map.Map' that is a prefix of the input.  Consumes the input that+-- matches the key, and returns the corresponding value in the+-- 'Map.Map', along with the residual input that follows the key.+mapI :: (ChunkData t, LL.ListLike t e, Ord t, Eq e, Monad m) =>+        Map t a -> Iter t m a+mapI mp | Map.null mp = fail $ "mapI: null map"+        | otherwise = do+  c@(Chunk t eof) <- chunkI+  if not (eof) && more t+    then iterF (runIter (mapI mp) . mappend c)+    else case findLongestPrefix mp t of+           Nothing -> Iter $ \c' ->+             Fail (IterExpected $+                   (show c+                   , show (Map.size mp) ++ " keys including the following:")+                   : map (\k -> ("", chunkShow k)) (take 5 $ Map.keys mp))+             Nothing (Just $ mappend c c')+           Just (k, v) -> ungetI (LL.drop (LL.length k) t) >> return v+    where+      gtmap t = snd $ Map.split t mp+      more t | Map.null $ gtmap t = False+             | otherwise = t `LL.isPrefixOf` (fst $ Map.findMin $ gtmap t)++-- | @mapLI@ is a variant of 'mapI' that takes a list of+-- @(key, value)@ pairs instead of a 'Map.Map'.+-- @mapLI = 'mapI' . 'Map.fromList'@.+mapLI :: (ChunkData t, LL.ListLike t e, Ord t, Eq e, Monad m) =>+         [(t, a)] -> Iter t m a+mapLI = mapI . Map.fromList+++++{-+main :: IO ()+main = enumStdin |$ do+         inumStopString end .| stdoutI+         match end+         liftIO $ putStrLn "\n\n*** We have reached THE END #1 ***\n\n"+         inumStopString end .| stdoutI+         match end+         liftIO $ putStrLn "\n\n*** We have reached THE END #2 ***\n\n"+         stdoutI+    where+      end = L8.pack "TheEnd"+-}

@@ -0,0 +1,394 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}++-- These extensions are only for MTL stuff where it is required+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module contains various helper functions and instances for+-- using 'Iter's of different 'Monad's together in the same pipeline.+-- For example, as-is the following code is illegal:+--+-- @+--iter1 :: 'Iter' String IO Bool+--iter1 = ...+-- +--iter2 :: 'Iter' String ('StateT' MyState IO) ()+--iter2 = do ...+--           s <- iter1 -- ILLEGAL: iter1 is in wrong monad+--           ...+-- @+--+-- You can't invoke @iter1@ from within @iter2@ because the 'Iter'+-- type is wrapped around a different 'Monad' in each case.  However,+-- the function 'liftI' exactly solves this problem:+--+-- @+--           s <- liftI iter1+-- @+--+-- Conversely, you may be in a 'Monad' like @'Iter' String IO@ and+-- need to invoke a computation that requires some other monad+-- functionality, such as a reader.  There are a number of+-- iteratee-specific runner functions that help you run other+-- 'MonadTrans' transformers inside the 'Iter' monad.  These typically+-- use the names of the runner functions in the mtl library, but with+-- an @I@ appended--for instance 'runReaderTI', 'runStateTI',+-- 'runWriterTI'.  Here's a fuller example of adapting the inner+-- 'Iter' 'Monad'.  The example also illustrates that @'Iter' t m@ is+-- member any mtl classes (such as 'MonadReader' and 'MonadState')+-- that @m@ is.+--+-- @+--iter1 :: Iter String ('ReaderT' MyState IO) Bool+--iter1 = do+--  s <- 'ask'+--  liftIO $ ('putStrLn' ('show' s) >> return True)+--        ``catch`` \('SomeException' _) -> return False+--+--iter2 :: Iter String ('StateT' MyState IO) ()+--iter2 = do+--  s <- 'get'+--  ok <- 'liftI' $ 'runReaderTI' iter1 s+--  if ok then return () else fail \"iter1 failed\"+-- @+module Data.IterIO.Trans (-- * Adapters for Iters of mtl transformers+                          liftI, liftIterIO+                         , runContTI, runErrorTI, runListTI, runReaderTI+                         , runRWSI, runRWSLI, runStateTI, runStateTLI+                         , runWriterTI, runWriterTLI+                         -- * Functions for building new monad adapters+                         , adaptIter, adaptIterM+                         -- * Iter-specific state monad transformer+                         , IterStateT(..), runIterStateT+                         , iget, igets, iput, imodify+                         ) where++import Control.Monad.Cont+import Control.Monad.Error+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.RWS.Strict+import Control.Monad.State.Strict+import Control.Monad.Writer.Strict+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.Writer.Lazy as Lazy+import Control.Monad+import Control.Monad.Trans++import Data.IterIO.Iter++--+-- IterStateT monad+--++-- | @IterStateT@ is a variant of the 'StateT' monad transformer+-- specifically designed for use inside 'Iter's.  The 'IterStateT'+-- Monad itself is the same as 'StateT'.  However, the 'runIterStateT'+-- function works differently from 'runStateT'--it returns an 'IterR'+-- and the result state separately.  The advantage of this approach is+-- that you can still recover the state at the point of the excaption+-- even after an 'IterFail' or 'InumFail' condition.+newtype IterStateT s m a = IterStateT (s -> m (a, s))++instance (Monad m) => Monad (IterStateT s m) where+    return a = IterStateT $ \s -> return (a, s)+    (IterStateT mf) >>= k = IterStateT $ \s -> do (a, s') <- mf s+                                                  let (IterStateT kf) = k a+                                                  kf $! s'+    fail = IterStateT . const . fail++instance MonadTrans (IterStateT s) where+    lift m = IterStateT $ \s -> m >>= \a -> return (a, s)++instance (MonadIO m) => MonadIO (IterStateT s m) where+    liftIO = lift . liftIO++-- | Runs an @'IterStateT' s m@ computation on some state @s@.+-- Returns the result ('IterR') of the 'Iter' and the state of @s@ as+-- a pair.  Pulls residual input up to the enclosing 'Iter' monad (as+-- with @'pullupResid'@ in "Data.IterIO.Inum").+runIterStateT :: (ChunkData t, Monad m) => +                 Iter t (IterStateT s m) a -> s -> Iter t m (IterR t m a, s)+runIterStateT i0 s0 = Iter $ adapt s0 . runIter i0+    where adapt s (IterM (IterStateT f)) =+              IterM $ liftM (uncurry $ flip adapt) (f s)+          adapt s r =+              stepR' r (adapt s) $ Done (setResid r mempty, s) (getResid r)+                +-- | Returns the state in an @'Iter' t ('IterStateT' s m)@ monad.+-- Analogous to @'get'@ for a @'StateT' s m@ monad.+iget :: (Monad m) => Iter t (IterStateT s m) s+iget = lift $ IterStateT $ \s -> return (s, s)++-- | Returns a particular field of the 'IterStateT' state, analogous+-- to @'gets'@ for @'StateT'@.+igets :: (Monad m) => (s -> a) -> Iter t (IterStateT s m) a+igets f = liftM f iget++-- | Sets the 'IterStateT' state.  Analogous to @'put'@ for+-- @'StateT'@.+iput :: (Monad m) => s -> Iter t (IterStateT s m) ()+iput s = lift $ IterStateT $ \_ -> return ((), s)++-- | Modifies the 'IterStateT' state.  Analogous to @'modify'@ for+-- @'StateT'@.+imodify :: (Monad m) => (s -> s) -> Iter t (IterStateT s m) ()+imodify f = lift $ IterStateT $ \s -> return ((), f s)++--+-- Adapter utility functions+--++-- | Adapt an 'Iter' from one monad to another.  This function is the+-- lowest-level monad adapter function, upon which all of the other+-- adapters are built.  @adaptIter@ requires two functions as+-- arguments.  One adapts the result to a new type (if required).  The+-- second adapts monadic computations from one monad to the other.+-- For example, 'liftI' could be implemented as:+--+-- @+--  liftI :: ('MonadTrans' t, Monad m, Monad (t m), 'ChunkData' s) =>+--           'Iter' s m a -> 'Iter' s (t m) a+--  liftI = adaptIter 'id' (\\m -> 'lift' ('lift' m) >>= liftI)+-- @+--+-- Here @'lift' ('lift' m)@ executes a computation @m@ of type @m+-- ('Iter' s m a)@ from within the @'Iter' s (t m)@ monad.  The+-- result, of type @'Iter' s m a@, can then be fed back into+-- @liftI@ recursively.+--+-- Note that in general a computation adapters must invoke the outer+-- adapter function recursively.  @adaptIter@ is designed this way+-- because the result adapter function may need to change.  An example+-- is 'runStateTI', which could be implemented as follows:+--+-- > runStateTI :: (ChunkData t, Monad m) =>+-- >               Iter t (StateT s m) a -> s -> Iter t m (a, s)+-- > runStateTI iter s = adaptIter adaptResult adaptComputation iter+-- >     where adaptResult a = (a, s)+-- >           adaptComputation m = do (r', s') <- lift (runStateT m s)+-- >                                   runStateTI r' s'+--+-- Here, after executing 'runStateT', the state may be modified.+-- Thus, @adaptComputation@ invokes @runStateTI@ recursively with the+-- modified state, @s'@, to ensure that subsequent 'IterM'+-- computations will be run on the latest state, and that eventually+-- @adaptResult@ will pair the result @a@ with the newest state.+adaptIter :: (ChunkData t, Monad m1) =>+             (a -> b)                          -- ^ How to adapt result values+          -> (m1 (Iter t m1 a) -> Iter t m2 b) -- ^ How to adapt computations+          -> Iter t m1 a                       -- ^ Input computation+          -> Iter t m2 b                       -- ^ Output computation+adaptIter f mf i = Iter $ check . runIter i+    where check (IterM m) = runIter (mf $ liftM (Iter . runIterR) m) mempty+          check r = stepR' r check $ fmapR f r++-- | Simplified adapter function to translate 'Iter' computations from+-- one monad to another.  This only works on monads @m@ for which+-- running @m a@ returns a result of type @a@.  For more complex+-- scenarios (such as 'ListT' or 'StateT'), you need to use the more+-- general 'adaptIter'.+--+-- As an example, the 'liftIterIO' function is implemented as follows:+--+-- @+-- liftIterIO :: (ChunkData t, 'MonadIO' m) => Iter t IO a -> Iter t m a+-- liftIterIO = adaptIterM 'liftIO'+-- @+adaptIterM :: (ChunkData t, Monad m1, Monad m2) =>+              (m1 (Iter t m1 a) -> m2 (Iter t m1 a)) -- ^ Conversion function+           -> Iter t m1 a       -- ^ 'Iter' of input monad+           -> Iter t m2 a       -- ^ Returns 'Iter' of output monad+adaptIterM f = adapt+    where adapt = adaptIter id $ lift . f >=> adapt++-- | Run an @'Iter' s m@ computation from witin the @'Iter' s (t m)@+-- monad, where @t@ is a 'MonadTrans'.+liftI :: (MonadTrans t, Monad m, Monad (t m), ChunkData s) =>+         Iter s m a -> Iter s (t m) a+liftI = adaptIterM lift++-- | Run an @'Iter' t IO@ computation from within an @'Iter' t m@+-- monad where @m@ is in class 'MonadIO'.+liftIterIO :: (ChunkData t, MonadIO m) =>+              Iter t IO a -> Iter t m a+liftIterIO = adaptIterM liftIO++--+-- mtl runner functions+--++-- | The type signature says it all.  Just a slightly optimized+-- version of @joinlift = join . lift@.+joinlift :: (Monad m) => m (Iter t m a) -> Iter t m a+joinlift m = Iter $ \c -> IterM $ m >>= \i -> return $ runIter i c++-- | Turn a computation of type @'Iter' t ('ContT' ('Iter' t m a) m)+-- a@ into one of type @'Iter' t m a@.  Note the continuation has to+-- return type @'Iter' t m a@ and not @a@ so that runContTI can call+-- itself recursively.+runContTI :: (ChunkData t, Monad m) =>+             Iter t (ContT (Iter t m a) m) a -> Iter t m a+runContTI = adaptIter id adapt+    where adapt m = joinlift $ runContT m $ return . runContTI+--        adapt :: ContT (Iter t m a) m (Iter t (ContT (Iter t m a) m) a)+--              -> Iter t m a++-- | Run a computation of type @'Iter' t ('ErrorT' e m)@ from within+-- the @'Iter' t m@ monad.  This function is here for completeness,+-- but please consider using 'throwI' instead, since the 'Iter' monad+-- already has built-in exception handling and it's best to have a+-- single, uniform approach to error reporting.+runErrorTI :: (Monad m, ChunkData t, Error e) =>+              Iter t (ErrorT e m) a -> Iter t m (Either e a)+runErrorTI = adaptIter Right $ lift . runErrorT >=> next+    where next (Left e)     = return $ Left e+          next (Right iter) = runErrorTI iter++-- | Run an @'Iter' t ('ListT' m)@ computation from within the @'Iter'+-- t m@ monad.+runListTI :: (Monad m, ChunkData t) =>+             Iter t (ListT m) a -> Iter t m [a]+runListTI = adaptIter (: []) $+            lift . runListT >=> liftM concat . runListTI . sequence++-- | Run an @'Iter' t ('ReaderT' r m)@ computation from within the+-- @'Iter' t m@ monad.+runReaderTI :: (ChunkData t, Monad m) =>+               Iter t (ReaderT r m) a -> r -> Iter t m a+runReaderTI m r = adaptIterM (flip runReaderT r) m++-- | Run an @'Iter' t ('RWST' r w s m)@ computation from within the+-- @'Iter' t m@ monad.+runRWSI :: (ChunkData t, Monoid w, Monad m) =>+           Iter t (RWST r w s m) a -- ^ Computation to transform+        -> r                       -- ^ Reader State+        -> s                       -- ^ Mutable State+        -> Iter t m (a, s, w)      -- ^ Returns result, mutable state, writer+runRWSI iter0 r s0 = doRWS mempty s0 iter0+    where doRWS w s = adaptIter (\a -> (a, s, w)) $ \m -> do+                        (iter, s', w') <- lift $ runRWST m r s+                        doRWS (mappend w w') s' iter+                                                  +-- | Run an @'Iter' t ('Lazy.RWST' r w s m)@ computation from within+-- the @'Iter' t m@ monad.  Just like 'runRWSI', execpt this function+-- is for /Lazy/ 'Lazy.RWST' rather than strict 'RWST'.+runRWSLI :: (ChunkData t, Monoid w, Monad m) =>+           Iter t (Lazy.RWST r w s m) a+         -- ^ Computation to transform+        -> r                       -- ^ Reader State+        -> s                       -- ^ Mutable State+        -> Iter t m (a, s, w)      -- ^ Returns result, mutable state, writer+runRWSLI iter0 r s0 = doRWS mempty s0 iter0+    where doRWS w s = adaptIter (\a -> (a, s, w)) $ \m -> do+                        (iter, s', w') <- lift $ Lazy.runRWST m r s+                        doRWS (mappend w w') s' iter++-- | Run an @'Iter' t ('StateT' m)@ computation from within the+-- @'Iter' t m@ monad.+runStateTI :: (ChunkData t, Monad m) =>+              Iter t (StateT s m) a -> s -> Iter t m (a, s)+runStateTI iter0 s0 = adaptIter (\a -> (a, s0)) adapt iter0+    where adapt m = lift (runStateT m s0) >>= uncurry runStateTI++-- | Run an @'Iter' t ('Lazy.StateT' m)@ computation from within the+-- @'Iter' t m@ monad.  Just like 'runStateTI', except this function+-- works on /Lazy/ 'Lazy.StateT' rather than strict 'StateT'.+runStateTLI :: (ChunkData t, Monad m) =>+              Iter t (Lazy.StateT s m) a -> s -> Iter t m (a, s)+runStateTLI iter0 s0 = adaptIter (\a -> (a, s0)) adapt iter0+    where adapt m = lift (Lazy.runStateT m s0) >>= uncurry runStateTLI++-- | Run an @'Iter' t ('WriterT' w m)@ computation from within the+-- @'Iter' t m@ monad.+runWriterTI :: (ChunkData t, Monoid w, Monad m) =>+               Iter t (WriterT w m) a -> Iter t m (a, w)+runWriterTI = doW mempty+    where doW w = adaptIter (\a -> (a, w)) $+                  lift . runWriterT >=> \(iter, w') -> doW (mappend w w') iter++-- | Run an @'Iter' t ('Lazy.WriterT' w m)@ computation from within+-- the @'Iter' t m@ monad.  This is the same as 'runWriterT' but for+-- the /Lazy/ 'Lazy.WriterT', rather than the strict one.+runWriterTLI :: (ChunkData t, Monoid w, Monad m) =>+                Iter t (Lazy.WriterT w m) a -> Iter t m (a, w)+runWriterTLI = doW mempty+    where doW w = adaptIter (\a -> (a, w)) $+                  lift . Lazy.runWriterT >=> \(iter, w') ->+                  doW (mappend w w') iter++--+-- Below this line, we use FlexibleInstances and UndecidableInstances,+-- but only because this is required by mtl.+--++instance (ChunkData t, MonadCont m) => MonadCont (Iter t m) where+    callCC f = joinlift $ (callCC $ \cc -> return $ f (icont cc))+        where icont cc a = Iter $ \c -> IterM $ cc (Iter $ \_ -> Done a c)++instance (Error e, MonadError e m, ChunkData t) =>+    MonadError e (Iter t m) where+        throwError = lift . throwError+        catchError m0 h = adaptIter id (joinlift . runm) m0+            where runm m = do+                    r <- catchError (liftM Right m) (return . Left . h)+                    case r of+                      Right iter -> return $ catchError iter h+                      Left iter  -> return iter++instance (MonadReader r m, ChunkData t) => MonadReader r (Iter t m) where+    ask = lift ask+    local f = adaptIterM $ local f++instance (MonadState s m, ChunkData t) => MonadState s (Iter t m) where+    get = lift get+    put = lift . put++instance (Monoid w, MonadWriter w m, ChunkData t) =>+    MonadWriter w (Iter t m) where+        tell = lift . tell+        listen = adapt mempty+            where adapt w = adaptIter (\a -> (a, w)) $+                            lift . listen >=> \(iter, w') ->+                            adapt (mappend w w') iter+        pass m = do+          ((a, f), w) <- adapt mempty m+          tell (f w)+          return a+            where+              adapt w = adaptIter (\af -> (af, w)) $+                        lift . censor (const mempty) . listen >=> \(i, w') ->+                        adapt (mappend w w') i++--+-- and instances for IterStateT (which are identical to StateT)+--++unIterStateT :: IterStateT s m a -> (s -> m (a, s))+unIterStateT (IterStateT f) = f++instance (MonadCont m) => MonadCont (IterStateT s m) where+    callCC f = IterStateT $ \s -> callCC $ \c ->+               unIterStateT (f (\a -> IterStateT $ \s' -> c (a, s'))) s++instance (MonadError e m) => MonadError e (IterStateT s m) where+    throwError = lift . throwError+    catchError m h = IterStateT $ \s ->+                     unIterStateT m s `catchError` \e ->+                     unIterStateT (h e) s++instance (MonadReader r m) => MonadReader r (IterStateT s m) where+    ask = lift ask+    local f m = IterStateT $ \s -> local f (unIterStateT m s)++instance (MonadWriter w m) => MonadWriter w (IterStateT s m) where+    tell = lift . tell+    listen m = IterStateT $ \s -> do+                 ((a, s'), w) <- listen (unIterStateT m s)+                 return ((a, w), s')+    pass   m = IterStateT $ \s -> pass $ do+                 ((a, f), s') <- unIterStateT m s+                 return ((a, s'), f)

@@ -0,0 +1,261 @@++module Data.IterIO.Zlib (-- * Codec and Inum functions+                         ZState, deflateInit2, inflateInit2+                        , inumZState, inumZlib, inumGzip, inumGunzip+                        -- * Constants from zlib.h+                        , max_wbits, max_mem_level, def_mem_level, zlib_version+                        , z_DEFAULT_COMPRESSION+                        , ZStrategy, z_FILTERED, z_HUFFMAN_ONLY, z_RLE+                        , z_FIXED, z_DEFAULT_STRATEGY+                        , ZMethod, z_DEFLATED+                        ) where++import Prelude hiding (null)+import Control.Exception (throwIO, ErrorCall(..))+import Control.Monad.State.Strict+-- import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+import Foreign+import Foreign.C++import Data.IterIO.Iter+import Data.IterIO.Inum+import Data.IterIO.ZlibInt++-- | State used by 'inumZState', the most generic zlib 'Inum'.+-- Create the state using 'deflateInit2' or 'inflateInit2'.+data ZState = ZState { zStream :: (ForeignPtr ZStream)+                     , zOp :: (ZFlush -> IO CInt)+                     , zFinish :: !ZFlush+                     , zInChunk :: !(ForeignPtr Word8)+                     , zOutChunk :: !(ForeignPtr Word8)+                     , zOut :: L.ByteString -> L.ByteString+                     }++defaultZState :: ZState+defaultZState = ZState { zStream = error "must allocate zStream"+                       , zOp = error "must define zOp"+                       , zFinish = z_FINISH+                       , zInChunk = S.nullForeignPtr+                       , zOutChunk = S.nullForeignPtr +                       , zOut = id+                       }++newZStream :: (Ptr ZStream -> IO CInt) -> IO (ForeignPtr ZStream)+newZStream initfn = do+  zs <- mallocForeignPtrBytes z_stream_size+  withForeignPtr zs $ \ptr ->+      do _ <- S.memset (castPtr ptr) 0 z_stream_size+         err <- initfn ptr+         when (err /= z_OK) $ throwIO $ ErrorCall "newZStream: init failed"+  return zs++-- | Create a 'ZState' for compression.  See the description of+-- @deflateInit2@ in the zlib.h C header file for a more detailed+-- description of the arguments.  Note in particular that the value of+-- @windowBits@ determines the encapsulation format of the compressed+-- data:+--+--   *   8..15 = zlib format+--+--   *  24..31 = gzip format+--+--   * -8..-15 = means raw zlib format with no header+deflateInit2 :: CInt+             -- ^ Compression level (use 'z_DEFAULT_COMPRESSION' for default)+             -> ZMethod+             -- ^ Method (use 'z_DEFLATED')+             -> CInt+             -- ^ @windowBits@ (e.g., 'max_wbits')+             -> CInt+             -- ^ @memLevel@ (e.g., 'def_mem_level')+             -> ZStrategy+             -- ^ strategy (e.g., 'z_DEFAULT_STRATEGY')+             -> IO ZState+deflateInit2 level method windowBits memLevel strategy = do+  z <- newZStream $ \ptr -> (c_deflateInit2 ptr level method windowBits+                             memLevel strategy zlib_version z_stream_size)+  addForeignPtrFinalizer c_deflateEnd z+  return defaultZState { zStream = z+                       , zOp = \flush -> withForeignPtr z $ \zp ->+                         c_deflate zp flush+                       }++-- | Create a 'Zstate' for uncompression.  See the description of+-- @inflateInit2@ in the zlib.h C header file for a more detailed+-- description of the arguments.  Note in particular that the value of+-- @windowBits@ determines the encapsulation format of the compressed+-- data:+--+--   *   8..15 = zlib format+--+--   *  24..31 = gzip format+--+--   *  40..47 = automatically determine zlib/gzip format+--+--   * -8..-15 = means raw zlib format with no header+inflateInit2 :: CInt+             -- ^ windowBits+             -> IO ZState+inflateInit2 windowBits = do+  z <- newZStream $ \ptr -> (c_inflateInit2 ptr windowBits+                             zlib_version z_stream_size)+  addForeignPtrFinalizer c_inflateEnd z+  return defaultZState { zStream = z+                       , zOp = \flush -> withForeignPtr z $ \zp ->+                         c_inflate zp flush+                       , zFinish = z_NO_FLUSH+                       -- Library documentation makes it sound like+                       -- you don't need Z_FINISH for inflating, and+                       -- it could cause problems if the output buffer+                       -- is not large enough.+                       }++type ZM = StateT ZState IO++withZFP :: (ZState -> ForeignPtr a) -> (Ptr a -> ZM b) -> ZM b+withZFP field k = StateT $ \zs ->+                withForeignPtr (field zs) $ \v -> (runStateT $ k v) zs++zPeek :: (Storable a) => (Ptr ZStream -> Ptr a) -> ZM a+zPeek f = withZFP zStream $ liftIO . peek . f++zPoke :: (Storable a) => (Ptr ZStream -> Ptr a) -> a -> ZM ()+zPoke f a = withZFP zStream $ liftIO . flip poke a . f++zPokeFP :: (Ptr ZStream -> Ptr (Ptr Word8)) -> ForeignPtr Word8 -> Int -> ZM ()+zPokeFP f fp offset = withZFP zStream $ \z ->+                      liftIO $ withForeignPtr fp $ \p ->+                      poke (f z) $ p `plusPtr` offset++zMinusPtr :: (Ptr ZStream -> Ptr (Ptr Word8))+          -> (ZState -> ForeignPtr Word8)+          -> ZM Int+zMinusPtr curf basef = withZFP basef $ \base ->+                       if base == nullPtr+                       then return 0+                       else do+                         cur <- zPeek curf+                         return $ cur `minusPtr` base++zPushIn :: L.ByteString -> ZM L.ByteString+zPushIn s = do+  avail <- zPeek avail_in+  if avail > 0 then return s else pushit s+    where+      pushit (L.Chunk h t) = do+              let (fp, offset, len) = S.toForeignPtr h+              modify $ \zs -> zs { zInChunk = fp }+              zPokeFP next_in fp offset+              zPoke avail_in $ fromIntegral len+              return t+      pushit L.Empty = return L.Empty++zPopIn :: L.ByteString -> ZM L.ByteString+zPopIn s = do+  len <- zPeek avail_in+  if len <= 0+    then return s+    else do+      fptr <- gets zInChunk+      offset <- zMinusPtr next_in zInChunk+      zPoke avail_in 0+      return $ L.chunk (S.fromForeignPtr fptr offset $ fromIntegral len) s++zOutLen :: ZM Int+zOutLen = zMinusPtr next_out zOutChunk++zPopOut :: ZM ()+zPopOut = do+  len <- zOutLen+  when (len > 0) $ do+            ochunk <- liftM (\c -> S.fromForeignPtr c 0 len) $ gets zOutChunk+            out <- liftM (. L.chunk ochunk) $ gets zOut+            modify $ \zs -> zs { zOutChunk = S.nullForeignPtr+                               , zOut = out }+            zPoke avail_out 0++zMkSpace :: ZM ()+zMkSpace = do+  avail <- zPeek avail_out+  when (avail <= 0) $ do+             zPopOut+             nchunk <- liftIO $ S.mallocByteString L.defaultChunkSize+             zPokeFP next_out nchunk 0+             zPoke avail_out $ fromIntegral L.defaultChunkSize+             modify $ \zs -> zs { zOutChunk = nchunk }++zExec :: ZFlush -> ZM CInt+zExec flush = do+  zMkSpace+  op <- gets zOp+  r <- withZFP zInChunk $ \_ -> liftIO $ op flush+  avail <- zPeek avail_out+  case () of+    _ | r == z_OK && avail == 0 -> zExec flush+    _ | r == z_NEED_DICT        -> liftIO $ throwIO $ ErrorCall "zlib NEED_DICT"+    _ | r == z_STREAM_END       -> do zPopOut+                                      return r+    _ | r < 0                   -> do cm <- zPeek msg+                                      m <- if cm == nullPtr+                                           then return $ "zlib failed ("+                                                    ++ show r ++ ")"+                                           else liftIO $ peekCString cm+                                      liftIO $ throwIO $ ErrorCall m+    _ | otherwise               -> return r+++-- | The most general zlib 'Inum', which can take any 'ZState' created+-- by 'deflateInit2' or 'inflateInit2'.+inumZState :: (MonadIO m) =>+              ZState+           -> Inum L.ByteString L.ByteString m a+inumZState = mkInumM . loop+    where+      loop zs0 = do+        (Chunk dat eof) <- chunkI+        ((r, rest), zs) <- liftIO (runStateT (runz eof dat) zs0)+        ungetI rest+        done <- ifeed $ zOut zs L.empty+        unless (done || eof || r == z_STREAM_END) $ loop zs { zOut = id }++      runz False L.Empty = return (z_OK, L.Empty)+      runz eof s0 = do+        s <- zPushIn s0+        flush <- if eof && L.null s then gets zFinish else return z_NO_FLUSH+        r <- zExec flush+        if r == z_STREAM_END || L.null s+          then do s' <- zPopIn s; return (r, s')+          else runz eof s++-- | An 'Inum' that compresses in zlib format.  To uncompress, use+-- 'inumGunzip'.+inumZlib :: (MonadIO m) => Inum L.ByteString L.ByteString m a+inumZlib iter = do+  zs <- liftIO (deflateInit2 z_DEFAULT_COMPRESSION z_DEFLATED max_wbits+                             def_mem_level z_DEFAULT_STRATEGY)+  inumZState zs iter++-- | An 'Inum' that compresses in gzip format.+inumGzip :: (MonadIO m) => Inum L.ByteString L.ByteString m a+inumGzip iter = do+  zs <- liftIO (deflateInit2 z_DEFAULT_COMPRESSION z_DEFLATED (16 + max_wbits)+                             def_mem_level z_DEFAULT_STRATEGY)+  inumZState zs iter++-- | An 'Inum' that uncompresses a data in either the zlib or gzip+-- format.  Note that this only uncompresses one gzip stream.  Thus,+-- if you feed in the concatenation of multiple gzipped files,+-- @inumGunzip@ will stop after the first one.  If this is not what+-- you want, then use @'inumRepeat' inumGunzip@ to decode repeated+-- gzip streams.+inumGunzip :: (MonadIO m) => Inum L.ByteString L.ByteString m a+inumGunzip iter = do+  zs <- liftIO $ inflateInit2 (32 + max_wbits)+  inumZState zs iter++-- Local Variables:+-- haskell-program-name: "ghci -lz"+-- End:

@@ -0,0 +1,124 @@+{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}+{-# LANGUAGE ForeignFunctionInterface #-}++-- | This module exposes the raw FFI interface to zlib C functions.+-- It is intended for internal use only, and should not be imported by+-- code outside the IterIO library.+module Data.IterIO.ZlibInt where++import Data.Word+import Foreign+import Foreign.C++#include "zlib.h"++foreign import ccall unsafe "zlib.h deflateInit_"+    c_deflateInit :: Ptr ZStream -> CInt -> CString -> CInt -> IO CInt+foreign import ccall unsafe "zlib.h deflateInit2_"+    c_deflateInit2 :: Ptr ZStream -> CInt -> ZMethod -> CInt -> CInt+                   -> ZStrategy -> CString -> CInt -> IO CInt+foreign import ccall unsafe "zlib.h deflate"+    c_deflate :: Ptr ZStream -> ZFlush -> IO CInt+foreign import ccall unsafe "zlib.h &deflateEnd"+    c_deflateEnd :: FunPtr (Ptr ZStream -> IO ())++foreign import ccall unsafe "zlib.h inflateInit_"+    c_inflateInit :: Ptr ZStream -> CString -> CInt -> IO CInt+foreign import ccall unsafe "zlib.h inflateInit2_"+    c_inflateInit2 :: Ptr ZStream -> CInt -> CString -> CInt -> IO CInt+foreign import ccall unsafe "zlib.h inflate"+    c_inflate :: Ptr ZStream -> ZFlush -> IO CInt+foreign import ccall unsafe "zlib.h &inflateEnd"+    c_inflateEnd :: FunPtr (Ptr ZStream -> IO ())++-- | Use this value for zlib format.  Add 16 for gzip format.  Negate+-- for raw zlib format.  When uncompressing, add 32 to determine+-- zlib/gzip format automatically.+max_wbits :: CInt+max_wbits = #const MAX_WBITS++max_mem_level :: CInt+max_mem_level = #const MAX_MEM_LEVEL++def_mem_level :: CInt+def_mem_level = #const MAX_MEM_LEVEL > 8 ? 8 : MAX_MEM_LEVEL++zlib_version :: CString+zlib_version = unsafePerformIO $ newCAString #const_str ZLIB_VERSION++z_stream_size :: (Num a) => a+z_stream_size = #size z_stream++#def struct zssz { z_stream z; char c; };+z_stream_alignment :: Int+z_stream_alignment = #const sizeof (struct zssz) - sizeof (z_stream)++data ZStream = ZStream++#{let zoffdef type, field =+          #field " :: Ptr ZStream -> Ptr (" #type ")\n"+          #field " zptr = zptr `plusPtr` %ld"+          , (long) offsetof (z_stream, field)}+#zoffdef Ptr Word8, next_in+#zoffdef CUInt, avail_in+#zoffdef CULong, total_in+#zoffdef Ptr Word8, next_out+#zoffdef CUInt, avail_out+#zoffdef CULong, total_out+#zoffdef CString, msg+#zoffdef FunPtr (Ptr a -> CUInt -> CUInt -> Ptr b), zalloc+#zoffdef FunPtr (Ptr a -> Ptr b -> ()), zfree+#zoffdef Ptr a, opaque+#zoffdef ZDataType, data_type+#zoffdef CULong, adler++newtype ZFlush = ZFlush CInt+#{enum ZFlush, ZFlush+ , z_NO_FLUSH = Z_NO_FLUSH+ , z_SYNC_FLUSH = Z_SYNC_FLUSH+ , z_FULL_FLUSH = Z_FULL_FLUSH+ , z_FINISH = Z_FINISH+ , z_BLOCK = Z_BLOCK+ }++#{enum CInt,+ , z_OK = Z_OK+ , z_STREAM_END = Z_STREAM_END+ , z_NEED_DICT = Z_NEED_DICT+ , z_ERRNO = Z_ERRNO+ , z_STREAM_ERROR = Z_STREAM_ERROR+ , z_DATA_ERROR = Z_DATA_ERROR+ , z_MEM_ERROR = Z_MEM_ERROR+ , z_BUF_ERROR = Z_BUF_ERROR+ , z_VERSION_ERROR = Z_VERSION_ERROR+ }++#{enum CInt,+ , z_DEFAULT_COMPRESSION = Z_DEFAULT_COMPRESSION+ }++newtype ZStrategy = ZStrategy CInt+#{enum ZStrategy, ZStrategy+ , z_FILTERED = Z_FILTERED+ , z_HUFFMAN_ONLY = Z_HUFFMAN_ONLY+ , z_RLE = Z_RLE+ , z_FIXED = Z_FIXED+ , z_DEFAULT_STRATEGY = Z_DEFAULT_STRATEGY+ }++newtype ZDataType = ZDataType CInt+#{enum ZDataType, ZDataType+ , z_BINARY = Z_BINARY+ , z_TEXT = Z_TEXT+ , z_UNKNOWN = Z_UNKNOWN+ }++newtype ZMethod = ZMethod CInt+#{enum ZMethod, ZMethod+ , z_DEFLATED = Z_DEFLATED+ }+++-- Local Variables:+-- haskell-program-name: "ghci -lz"+-- End:

@@ -0,0 +1,59 @@++module Main where++import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteString.Lazy as L++import Control.Monad+import Control.Monad.Trans+import System.Environment+import System.Exit+import System.IO+-- import System.IO.Error++import Data.IterIO++filterLines :: (Monad m) =>+               String+            -> Inum L.ByteString [L.ByteString] m a+filterLines s = mkInum loop+    where+      loop = do line <- lineI+                if match line then return [line] else loop+      ls = L8.pack s+      match l | L.null l  = False+              | otherwise = L.isPrefixOf ls l || match (L.tail l)++printLines :: (MonadIO m) => Iter [L.ByteString] m ()+printLines = do+  line <- safeHeadI+  case line of+    Just l -> do liftIO $ L.putStrLn l+                 printLines+    Nothing -> return ()++enumFileCatchError :: (MonadIO m) => FilePath -> Onum L.ByteString m a+enumFileCatchError file = enumFile file `inumCatch` enumCatchIO+    where+      enumCatchIO :: (ChunkData t, MonadIO m) =>+                     IOError+                  -> IterR () m (IterR t m a)+                  -> Iter () m (IterR t m a)+      enumCatchIO _ = verboseResumeI+      -- or to avoid the need for a type signature, you could say:+      -- enumCatchIO e = flip const (e :: IOError) verboseResumeI++main :: IO ()+main = do+  prog <- getProgName+  av <- getArgs+  unless (length av >= 1) $ do+         hPutStrLn stderr $ "usage: " ++ prog ++ " string [file ...]"+         exitFailure+  hSetBuffering stdout NoBuffering+  let pat = head av+      enum = if length av == 1+             then enumHandle stdin+             else foldr1 cat $ map enumFileCatchError $ tail av+  enum |. filterLines pat |$ printLines+  exitSuccess

@@ -0,0 +1,115 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Prelude hiding (catch, head, id, div)+import Control.Concurrent+import Control.Exception+import Control.Monad+import Control.Monad.Trans+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+-- import qualified Data.ByteString.Lazy.Char8 as L8+import Data.Monoid+import qualified Network.Socket as Net+import qualified OpenSSL as SSL+import qualified OpenSSL.Session as SSL+import System.IO+import System.Posix.Files++import Data.IterIO+-- import Data.IterIO.Parse+import Data.IterIO.Http+import Data.IterIO.HttpRoute+import Data.IterIO.SSL+import System.Directory (getAppUserDataDirectory)+import System.IO.Unsafe (unsafePerformIO)++type L = L.ByteString++data HttpServer = HttpServer {+      hsListenSock :: !Net.Socket+    , hsSslCtx :: !(Maybe SSL.SSLContext)+    , hsLog :: !(Maybe Handle)+    }++myListen :: Net.PortNumber -> IO Net.Socket+myListen pn = do+  sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol+  Net.setSocketOption sock Net.ReuseAddr 1+  Net.bindSocket sock (Net.SockAddrInet pn Net.iNADDR_ANY)+  Net.listen sock Net.maxListenQueue+  return sock++mkServer :: Net.PortNumber -> Maybe SSL.SSLContext -> IO HttpServer+mkServer port mctx = do+  sock <- myListen port+  h <- openBinaryFile "http.log" WriteMode+  hSetBuffering h NoBuffering+  return $ HttpServer sock mctx (Just h)++mimeMap :: String -> S8.ByteString+mimeMap = unsafePerformIO $ do+            path <- findMimeTypes ["mime.types"+                                  , "/etc/mime.types"+                                  , "/var/www/conf/mime.types"]+            enumFile path |$ mimeTypesI "application/octet-stream"+    where+      findMimeTypes (h:t) = do exist <- fileExist h+                               if exist then return h else findMimeTypes t+      findMimeTypes []    = return "mime.types" -- cause error++routeFS :: (MonadIO m) => FilePath -> HttpRoute m+routeFS = routeFileSys mimeMap (dirRedir "index.html")++cabal_dir :: String+cabal_dir = (unsafePerformIO $ getAppUserDataDirectory "cabal") ++ "/share/doc"++route :: (MonadIO m) => HttpRoute m+route = mconcat+        [ routeTop $ routeConst $ resp301 "/cabal"+        , routeMap' [ ("cabal", routeConst $ resp301 cabal_dir)+                    , ("static", routeFS "static") -- directory ./static+                    , ("favicon.ico"+                      -- serve /favicon.ico from file ./static/favicon.ico,+                      -- but tell browser to cache it for 1 day+                      , addHeader "Cache-Control: max-age=86400" $+                                  routeFS "static/favicon.ico")+                    ]+        , routePath cabal_dir $ routeFS cabal_dir+        , routePath "/usr/share/doc/ghc/html" $+                    routeFS "/usr/share/doc/ghc/html"+        ]++accept_loop :: HttpServer -> IO ()+accept_loop srv = loop+    where+      loop = do+        (s, addr) <- Net.accept $ hsListenSock srv+        hPutStrLn stderr (show addr)+        _ <- forkIO $ server s+        loop+      server s = do+        (iter, enum) <- maybe (iterStream s) (\ctx -> iterSSL ctx s True)+                        (hsSslCtx srv)+        let loger = maybe inumNop inumhLog $ hsLog srv+        enum |. loger |$ inumHttpServer (ioHttpServer handler) .| loger .| iter+      handler = runHttpRoute route++main :: IO ()+main = Net.withSocketsDo $ SSL.withOpenSSL $ do+  mctx <- if secure+          then do+            exists <- fileExist privkey+            unless exists $ genSelfSigned privkey "localhost"+            ctx <- simpleContext privkey+            return $ Just ctx+          else return Nothing+  srv <- mkServer (if secure then 4433 else 8000) mctx+  sem <- newQSem 0+  _ <- forkIO $ accept_loop srv `finally` signalQSem sem+  waitQSem sem+    where+      privkey = "testkey.pem"+      secure = True

@@ -0,0 +1,24 @@++module Main where++import System.Environment+import System.IO++import Data.IterIO+import Data.IterIO.Zlib++main :: IO ()+main = do+  av <- getArgs+  hSetBuffering stdout NoBuffering+  case av of+    -- The decision to put inumG[un]zip to the left or to the right+    -- of |$ is arbitrary, so we do one of each.+    []     -> enumStdin |$ inumGzip .| stdoutI+    ["-d"] -> enumStdin |. inumRepeat inumGunzip |$ stdoutI+    _      -> do prog <- getProgName+                 hPutStrLn stderr $ "usage: " ++ prog ++ " [-d]"++-- Local Variables:+-- haskell-program-name: "ghci -lz"+-- End:

@@ -0,0 +1,68 @@++PKG = $(basename $(wildcard *.cabal))+TARGETS := $(basename $(shell find Examples -name '[a-z]*.hs' -print))+TESTS := $(basename $(shell find tests -name '[a-z]*.hs' -print))+HSCS := $(patsubst %.hsc,%.hs,$(shell find . -name '*.hsc' -print))+HSCCLEAN = $(patsubst %.hs,%_hsc.[ch],$(HSCS))++all: $(TARGETS) $(HSCS)++.PHONY: all always clean build dist doc browse install hsc++GHC = ghc $(WALL)+#GHC = ghc $(WALL) -prof -auto-all -caf-all -rtsopts=all -with-rtsopts=-xc+WALL = -Wall -Werror+LIBS = -lz++always:+	@:++Examples/%: always $(HSCS)+	$(GHC) --make -i$(dir $@) $@.hs $(LIBS)++tests/%: always $(HSCS)+	$(GHC) --make $@.hs++%.hs: %.hsc+	hsc2hs $<++hsc: $(HSCS)++Setup: Setup.hs+	$(GHC) --make Setup.hs++dist/setup-config: Setup $(PKG).cabal+	./Setup configure --user++build: dist/setup-config+	./Setup build++doc: dist/setup-config+	./Setup haddock --hyperlink-source++dist: dist/setup-config+	./Setup sdist++INDEXDOC = cd $(HOME)/.cabal/share/doc \+    && find . -name '*.haddock' -print \+	| sed -e 's/\.\/\(.*\)\/[^\/]*\.haddock/--read-interface=\1,&/' \+	| xargs -t haddock --gen-contents --gen-index --odir=.++install: build doc+	./Setup install+	$(INDEXDOC)++uninstall: dist/setup-config+	./Setup unregister --user+	rm -rf $(HOME)/.cabal/lib/$(PKG)-[0-9]*+	rm -rf $(HOME)/.cabal/share/doc/$(PKG)-[0-9]*+	$(INDEXDOC)++browse: doc+	xdg-open dist/doc/html/$(PKG)/index.html++clean:+	rm -rf dist+	rm -f Setup $(TARGETS) $(TESTS) $(HSCS) $(HSCCLEAN)+	find . \( -name '*~' -o -name '*.hi' -o -name '*.o' \) -print0 \+		| xargs -0 rm -f --

@@ -0,0 +1,29 @@+Copyright (C) 2009 David Mazieres++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++   1. Redistributions of source code must retain the above copyright+      notice, this list of conditions, and the following disclaimer.++   2. Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions, and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++   3. The name of the author may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,11 @@++To build this package, install the Haskell platform+(http://hackage.haskell.org/platform/), then run the following+commands to install required packages:++	cabal update+	cabal install ListLike HSOpenSSL stringsearch attoparsec+	cabal install aeson blaze-html+	cabal install binary regex-posix xhtml utf8-string++Then run "make" or "gmake" to build the example programs.

@@ -0,0 +1,3 @@+import Distribution.Simple+main :: IO ()+main = defaultMain

@@ -0,0 +1,99 @@+Name:           iterIO+Homepage:       http://www.scs.stanford.edu/~dm/iterIO+Version:        0.1+Cabal-version:  >= 1.6+build-type:     Simple+License:        BSD3+License-file:   LICENSE+Author:         David Mazieres+Stability:      experimental+Maintainer:     http://www.scs.stanford.edu/~dm/addr/+Category:       System, Data, Enumerator+Synopsis:       Iteratee-based IO with pipe operators+Extra-source-files:+        GNUmakefile, README,+        Examples/fgrep.hs, Examples/zpipe.hs, Examples/httptest.hs++Description:++        Iteratee-based IO is an alternative to lazy IO that offers+        better error handling, referential transparency, and+        convenient composition of protocol layers or parsers.  This+        package provides iteratees based around /pipe/ operators for+        hooking together application components and directing data+        flow.  New users should see the tutorial in the "Data.IterIO"+        module documentation.  Highlights of the library include:++        .++        * Heavy emphasis on ease of use, ease of learning, and+          uniformity of mechanism.++        .++        * Copious documentation.++        .++        * Consistent EOF and error handling to avoid resource leaks+          and other issues in corner cases.++        .++        * A set of iteratee parsing combinators providing LL(*)+          parsing while generally not consuming large amounts of+          memory for backtracking.++        .++        * Seamless integration with attoparsec for LL(1) parsing.++        .++        See "Data.IterIO" for a discussion of the differences between+	iterIO and the two previous iteratee implementations (iteratee+	and enumerator).++Source-repository head+  Type:     git+  Location: http://www.scs.stanford.edu/~dm/repos/iterIO.git++Library+  Build-depends: array >= 0.3.0.1 && < 2,+                 base >= 4.3 && < 6,+                 bytestring >= 0.9 && < 2,+                 containers >= 0.3 && < 2,+                 filepath >= 1.2 && < 2,+                 HsOpenSSL >= 0.8 && < 2,+                 ListLike >= 1.0 && < 4,+                 mtl >= 1.1.0.2 && < 3,+                 network >= 2.3 && < 3,+                 old-locale >= 1.0.0.2 && < 2,+                 attoparsec >= 0.8.5 && < 2,+                 process >= 1.0.1.3 && < 2,+                 stringsearch >= 0.3 && < 2,+                 time >= 1.1.4 && < 2,+                 unix >= 2.4 && < 3++  ghc-options: -Wall+  Exposed-modules:+    Data.IterIO,+    Data.IterIO.Atto,+    Data.IterIO.Iter,+    Data.IterIO.Extra,+    Data.IterIO.Http,+    Data.IterIO.HttpRoute,+    Data.IterIO.Inum,+    Data.IterIO.ListLike,+    Data.IterIO.Parse,+    Data.IterIO.SSL,+    Data.IterIO.Search,+    Data.IterIO.Trans,+    Data.IterIO.Zlib+  Other-modules:+    Data.IterIO.ZlibInt+  Extensions:+    ForeignFunctionInterface, DeriveDataTypeable,+    ExistentialQuantification, MultiParamTypeClasses,+    FunctionalDependencies, FlexibleInstances+  Extra-libraries: z