apiary 1.2.0 → 1.2.1

raw patch · 13 files changed

+577/−30 lines, 13 filesdep +stringsearchdep ~monad-controlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: stringsearch

Dependency ranges changed: monad-control

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• apiary.cabal +8/−6
• src/Control/Monad/Apiary/Action.hs +1/−2
• src/Control/Monad/Apiary/Action/Internal.hs +86/−2
• src/Control/Monad/Apiary/Filter.hs +1/−7
• src/Control/Monad/Apiary/Filter/Capture.hs +5/−0
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +2/−1
• src/Control/Monad/Apiary/Internal.hs +43/−7
• src/Data/Apiary/Document/Internal.hs +9/−1
• src/Data/Apiary/Extension/Internal.hs +6/−1
• src/Data/Apiary/Method.hs +6/−1
• src/Network/Wai/Parse.hs +401/−0
• src/Web/Apiary.hs +3/−2

@@ -1,3 +1,9 @@+# 1.2.1+* reduce dependencies.+* relax version restriction of monad-control.+* move pure capture function.+* export hoistActionT, focus', noExtension.+ # 1.2.0 * good bye wai-2. * add Web.Apiary.Develop module for develop static file.

@@ -1,6 +1,6 @@ name:                apiary-version:             1.2.0-synopsis:            Simple and type safe web framework that can be automatically generate API documentation.+version:             1.2.1+synopsis:            Simple and type safe web framework that generate web API documentation. description:   Simple and type safe web framework that can be automatically generate API documentation.   .@@ -18,7 +18,7 @@   &#32;&#32;&#32;&#32;&#32;&#32;(age, name) <- [params|age,name|]   &#32;&#32;&#32;&#32;&#32;&#32;guard (age >= 18)   &#32;&#32;&#32;&#32;&#32;&#32;contentType &#34;text/html&#34;-  &#32;&#32;&#32;&#32;&#32;&#32;mapM_ lazyBytes [&#34;&#60;h1&#62;Hello, &#34;, name, &#34;!&#60;/h1&#62;\\n&#34;]+  &#32;&#32;&#32;&#32;&#32;&#32;mapM_ appendLazyBytes [&#34;&#60;h1&#62;Hello, &#34;, name, &#34;!&#60;/h1&#62;\\n&#34;]   @   .   @@@ -70,6 +70,7 @@                         Control.Monad.Apiary                        Control.Monad.Apiary.Filter+                       Control.Monad.Apiary.Filter.Capture                        Control.Monad.Apiary.Action                         Data.Apiary.Extension@@ -80,7 +81,8 @@                        Data.Apiary.Document                        Data.Apiary.Document.Html -  other-modules:       Data.Apiary.Document.Internal+  other-modules:       Network.Wai.Parse+                       Data.Apiary.Document.Internal                        Data.Apiary.Extension.Internal                        Control.Monad.Apiary.Internal                        Control.Monad.Apiary.Filter.Internal@@ -93,7 +95,7 @@                      , transformers         >=0.2   && <0.5                      , transformers-base    >=0.4   && <0.5                      , mtl                  >=2.1   && <2.3-                     , monad-control        >=0.3   && <0.4+                     , monad-control        >=0.3   && <1.1                      , exceptions           >=0.6   && <0.7                       , http-types           >=0.8   && <0.9@@ -117,7 +119,7 @@                      , http-date            >=0.0   && <0.1                       , wai                  >=3.0   && <3.1-                     , wai-extra            >=3.0   && <3.1+                     , stringsearch         >=0.3   && <0.4    default-extensions:  OverlappingInstances   hs-source-dirs:      src

@@ -1,5 +1,6 @@ module Control.Monad.Apiary.Action      ( ActionT+    , hoistActionT     -- * stop action     , stop @@ -63,5 +64,3 @@  import Control.Monad.Apiary.Action.Internal import Network.Wai-import Data.Apiary.Document.Html-

@@ -13,9 +13,80 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE CPP #-} -module Control.Monad.Apiary.Action.Internal where+module Control.Monad.Apiary.Action.Internal+    ( ActionT +    , stop++    , param+    , params++    , status++    , addHeader, setHeaders, modifyHeader+    , contentType++    , reset+    , builder+    , bytes, lazyBytes+    , text,  lazyText+    , showing+    , string, char+    , appendBuilder+    , appendBytes, appendLazyBytes+    , appendText, appendLazyText+    , appendShowing+    , appendString, appendChar+    , file+    , file'++    , redirect, redirectPermanently, redirectTemporary++    , defaultDocumentationAction+    , DefaultDocumentConfig(..)++    , hoistActionT+    , ContentType+    , stopWith++    , getRequest+    , getHeaders+    , getParams+    , getQueryParams+    , getReqBodyParams+    , getReqBodyFiles++    , devFile+    , devFile'+    , stream+    , rawResponse++    , lookupVault+    , modifyVault+    , insertVault+    , adjustVault+    , deleteVault++    , redirectWith++    -- internal+    , ApiaryConfig(..)+    , getState+    , modifyState+    , getRequestBody+    , actionFetches+    , execActionT+    , applyDict++    , MonadExts(..)+    , Extensions(..)+    , Extension(..)+    , Middleware'+    ) where++ import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote(QuasiQuoter(..)) @@ -43,7 +114,7 @@ import Data.Apiary.Param(Param, File(..)) import Data.Apiary.Compat(SProxy(..)) import Data.Apiary.Document(Documents)-import Data.Apiary.Document.Html(defaultDocumentToHtml, DefaultDocumentConfig)+import Data.Apiary.Document.Html(defaultDocumentToHtml, DefaultDocumentConfig(..)) import Data.Default.Class(Default(..))  import Blaze.ByteString.Builder(Builder)@@ -283,16 +354,29 @@ instance MonadBase b m => MonadBase b (ActionT exts prms m) where     liftBase = liftBaseDefault +-- `MIN_VERSION_base(major1,major2,minor) instance MonadTransControl (ActionT exts prms) where+#if MIN_VERSION_monad_control(1,0,0)+    type StT (ActionT exts prms) a = Action a+    liftWith f = actionT $ \prms e !s -> liftM (\a -> Continue s a) (f $ \t -> runActionT t prms e s)+    restoreT m = actionT $ \_ _ _ -> m+#else     newtype StT (ActionT exts prms) a = StActionT { unStActionT :: Action a }     liftWith f = actionT $ \prms e !s ->          liftM (\a -> Continue s a) (f $ \t -> liftM StActionT $ runActionT t prms e s)     restoreT m = actionT $ \_ _ _ -> liftM unStActionT m+#endif  instance MonadBaseControl b m => MonadBaseControl b (ActionT exts prms m) where+#if MIN_VERSION_monad_control(1,0,0)+    type StM (ActionT exts prms m) a = ComposeSt (ActionT exts prms) m a+    liftBaseWith = defaultLiftBaseWith+    restoreM     = defaultRestoreM+#else     newtype StM (ActionT exts prms m) a = StMActionT { unStMActionT :: ComposeSt (ActionT exts prms) m a }     liftBaseWith = defaultLiftBaseWith StMActionT     restoreM     = defaultRestoreM unStMActionT+#endif  instance MonadReader r m => MonadReader r (ActionT exts prms m) where     ask     = lift ask

@@ -32,13 +32,8 @@     , QueryKey(..)     , query     , Control.Monad.Apiary.Filter.httpVersion-    , Capture.path-    , Capture.endPath-    , Capture.fetch-    , Capture.restPath-    , Capture.anyPath -    , function, function', function_, focus+    , function, function', function_, focus, focus'     , Doc(..)     ) where @@ -57,7 +52,6 @@     , Doc(DocMethod, DocPrecondition, DocRoot, DocQuery, DocAccept)) import Control.Monad.Apiary.Filter.Internal.Capture.TH(capture) import Control.Monad.Apiary.Internal(ApiaryT, focus', focus, PathElem(RootPath))-import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture  import Text.Blaze.Html(Html, toHtml) import qualified Data.ByteString.Char8 as SC

@@ -0,0 +1,5 @@+module Control.Monad.Apiary.Filter.Capture+    ( path, endPath, fetch, anyPath, restPath+    ) where++import Control.Monad.Apiary.Filter.Internal.Capture

@@ -6,7 +6,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DataKinds #-} -module Control.Monad.Apiary.Filter.Internal.Capture where+module Control.Monad.Apiary.Filter.Internal.Capture+    ( path, endPath, fetch, fetch', anyPath, restPath ) where  import Control.Applicative((<$>), (<$)) import Control.Monad(liftM, mzero)

@@ -4,9 +4,33 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-} -module Control.Monad.Apiary.Internal where+module Control.Monad.Apiary.Internal+    ( ApiaryT +    , runApiaryTWith+    , runApiaryWith+    , runApiary+    , ApiaryConfig(..)++    , action++    , middleware+    , group+    , document+    , precondition+    , noDoc++    , apiaryConfig+    , apiaryExt++    -- internal+    , focus, focus'+    , PathElem(..)+    ) where++ import qualified Network.Wai as Wai  import Control.Applicative(Applicative(..), (<$>))@@ -211,16 +235,28 @@     liftBase m = ApiaryT $ \_ c -> liftBase m >>= \a -> c a mempty  instance Monad actM => MonadTransControl (ApiaryT exts prms actM) where-    newtype StT (ApiaryT exts prms actM) a = StTApiary' { unStTApiary' :: (a, ApiaryWriter exts actM) }+#if MIN_VERSION_monad_control(1,0,0)+    type StT (ApiaryT exts prms actM) a = (a, ApiaryWriter exts actM)+    liftWith f = apiaryT $ \env -> liftM (\a -> (a, mempty)) (f $ \t -> unApiaryT t env (\a w -> return (a,w)))+    restoreT = apiaryT . const+#else+    newtype StT (ApiaryT exts prms actM) a = StTApiary { unStTApiary :: (a, ApiaryWriter exts actM) }     liftWith f = apiaryT $ \env ->         liftM (\a -> (a, mempty)) -        (f $ \t -> liftM StTApiary' $ unApiaryT t env (\a w -> return (a,w)))-    restoreT m = apiaryT $ \_ -> liftM unStTApiary' m+        (f $ \t -> liftM StTApiary $ unApiaryT t env (\a w -> return (a,w)))+    restoreT m = apiaryT $ \_ -> liftM unStTApiary m+#endif  instance (Monad actM, MonadBaseControl b m) => MonadBaseControl b (ApiaryT exts prms actM m) where-    newtype StM (ApiaryT exts prms actM m) a = StMApiary' { unStMApiary' :: ComposeSt (ApiaryT exts prms actM) m a }-    liftBaseWith = defaultLiftBaseWith StMApiary'-    restoreM     = defaultRestoreM   unStMApiary'+#if MIN_VERSION_monad_control(1,0,0)+    type StM (ApiaryT exts prms actM m) a = ComposeSt (ApiaryT exts prms actM) m a+    liftBaseWith = defaultLiftBaseWith+    restoreM     = defaultRestoreM+#else+    newtype StM (ApiaryT exts prms actM m) a = StMApiary { unStMApiary :: ComposeSt (ApiaryT exts prms actM) m a }+    liftBaseWith = defaultLiftBaseWith StMApiary+    restoreM     = defaultRestoreM   unStMApiary+#endif  instance Monad actM => MonadExts exts (ApiaryT exts prms actM m) where     getExts = envExts <$> getApiaryEnv

@@ -2,7 +2,15 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} -module Data.Apiary.Document.Internal where+module Data.Apiary.Document.Internal+    ( Doc(..)+    , Documents(..)+    , PathDoc(..)+    , QueryDoc(..)+    , MethodDoc(..)+    , Route(..)+    , docsToDocuments+    ) where  import Control.Applicative((<$>)) 

@@ -7,7 +7,12 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-} -module Data.Apiary.Extension.Internal where+module Data.Apiary.Extension.Internal+    ( Initializer(..)+    , Has(..)+    , allMiddleware'+    , allMiddleware+    ) where  #if __GLASGOW_HASKELL__ >= 708 import qualified Control.Category as Cat

@@ -1,7 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -module Data.Apiary.Method where+module Data.Apiary.Method+    ( Method(..)+    , renderMethod+    , dispatchMethod+    , parseMethod+    ) where  import Data.Hashable(Hashable(..)) import Data.String(IsString(..))

@@ -0,0 +1,401 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-}+-- | Some helpers for parsing data out of a raw WAI 'Request'.+--+-- copy from wai-extra 3.0.3.++module Network.Wai.Parse+    ( parseHttpAccept+    , parseRequestBody+    , RequestBodyType (..)+    , getRequestBodyType+    , sinkRequestBody+    , BackEnd+    , lbsBackEnd+    , Param+    , File+    , FileInfo (..)+    , parseContentType+#if TEST+    , Bound (..)+    , findBound+    , sinkTillBound+    , killCR+    , killCRLF+    , takeLine+#endif+    ) where++import qualified Data.ByteString.Search as Search+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as S8+import Data.Word (Word8)+import Data.Maybe (fromMaybe)+import Data.List (sortBy)+import Data.Function (on)+import Network.Wai+import qualified Network.HTTP.Types as H+import Control.Monad (when, unless)+import Data.IORef++breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)+breakDiscard w s =+    let (x, y) = S.break (== w) s+     in (x, S.drop 1 y)++-- | Parse the HTTP accept string to determine supported content types.+parseHttpAccept :: S.ByteString -> [S.ByteString]+parseHttpAccept = map fst+                . sortBy (rcompare `on` snd)+                . map (addSpecificity . grabQ)+                . S.split 44 -- comma+  where+    rcompare :: (Double,Int) -> (Double,Int) -> Ordering+    rcompare = flip compare+    addSpecificity (s, q) =+        -- Prefer higher-specificity types+        let semicolons = S.count 0x3B s+            stars = S.count 0x2A s+        in (s, (q, semicolons - stars))+    grabQ s =+        -- Stripping all spaces may be too harsh.+        -- Maybe just strip either side of semicolon?+        let (s', q) = S.breakSubstring ";q=" (S.filter (/=0x20) s) -- 0x20 is space+            q' = S.takeWhile (/=0x3B) (S.drop 3 q) -- 0x3B is semicolon+         in (s', readQ q')+    readQ s = case reads $ S8.unpack s of+                (x, _):_ -> x+                _ -> 1.0++-- | Store uploaded files in memory+lbsBackEnd :: Monad m => ignored1 -> ignored2 -> m S.ByteString -> m L.ByteString+lbsBackEnd _ _ popper =+    loop id+  where+    loop front = do+        bs <- popper+        if S.null bs+            then return $ L.fromChunks $ front []+            else loop $ front . (bs:)++-- | Information on an uploaded file.+data FileInfo c = FileInfo+    { fileName :: S.ByteString+    , fileContentType :: S.ByteString+    , fileContent :: c+    }+    deriving (Eq, Show)++-- | Post parameter name and value.+type Param = (S.ByteString, S.ByteString)++-- | Post parameter name and associated file information.+type File y = (S.ByteString, FileInfo y)++-- | A file uploading backend. Takes the parameter name, file name, and a+-- stream of data.+type BackEnd a = S.ByteString -- ^ parameter name+              -> FileInfo ()+              -> IO S.ByteString+              -> IO a++data RequestBodyType = UrlEncoded | Multipart S.ByteString++getRequestBodyType :: Request -> Maybe RequestBodyType+getRequestBodyType req = do+    ctype' <- lookup "Content-Type" $ requestHeaders req+    let (ctype, attrs) = parseContentType ctype'+    case ctype of+        "application/x-www-form-urlencoded" -> return UrlEncoded+        "multipart/form-data" | Just bound <- lookup "boundary" attrs -> return $ Multipart bound+        _ -> Nothing++-- | Parse a content type value, turning a single @ByteString@ into the actual+-- content type and a list of pairs of attributes.+--+-- Since 1.3.2+parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])+parseContentType a = do+    let (ctype, b) = S.break (== semicolon) a+        attrs = goAttrs id $ S.drop 1 b+     in (ctype, attrs)+  where+    semicolon = 59+    equals = 61+    space = 32+    goAttrs front bs+        | S.null bs = front []+        | otherwise =+            let (x, rest) = S.break (== semicolon) bs+             in goAttrs (front . (goAttr x:)) $ S.drop 1 rest+    goAttr bs =+        let (k, v') = S.break (== equals) bs+            v = S.drop 1 v'+         in (strip k, strip v)+    strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)++parseRequestBody :: BackEnd y+                 -> Request+                 -> IO ([Param], [File y])+parseRequestBody s r =+    case getRequestBodyType r of+        Nothing -> return ([], [])+        Just rbt -> sinkRequestBody s rbt (requestBody r)++sinkRequestBody :: BackEnd y+                -> RequestBodyType+                -> IO S.ByteString+                -> IO ([Param], [File y])+sinkRequestBody s r body = do+    ref <- newIORef (id, id)+    let add x = atomicModifyIORef ref $ \(y, z) ->+            case x of+                Left y' -> ((y . (y':), z), ())+                Right z' -> ((y, z . (z':)), ())+    conduitRequestBody s r body add+    (x, y) <- readIORef ref+    return (x [], y [])++conduitRequestBody :: BackEnd y+                   -> RequestBodyType+                   -> IO S.ByteString+                   -> (Either Param (File y) -> IO ())+                   -> IO ()+conduitRequestBody _ UrlEncoded rbody add = do+    -- NOTE: in general, url-encoded data will be in a single chunk.+    -- Therefore, I'm optimizing for the usual case by sticking with+    -- strict byte strings here.+    let loop front = do+            bs <- rbody+            if S.null bs+                then return $ S.concat $ front []+                else loop $ front . (bs:)+    bs <- loop id+    mapM_ (add . Left) $ H.parseSimpleQuery bs+conduitRequestBody backend (Multipart bound) rbody add =+    parsePieces backend (S8.pack "--" `S.append` bound) rbody add++takeLine :: Source -> IO (Maybe S.ByteString)+takeLine src =+    go id+  where+    go front = do+        bs <- readSource src+        if S.null bs+            then close front+            else push front bs++    close front = leftover src (front S.empty) >> return Nothing+    push front bs = do+        let (x, y) = S.break (== 10) $ front bs -- LF+         in if S.null y+                then go $ S.append x+                else do+                    when (S.length y > 1) $ leftover src $ S.drop 1 y+                    return $ Just $ killCR x++takeLines :: Source -> IO [S.ByteString]+takeLines src = do+    res <- takeLine src+    case res of+        Nothing -> return []+        Just l+            | S.null l -> return []+            | otherwise -> do+                ls <- takeLines src+                return $ l : ls++data Source = Source (IO S.ByteString) (IORef S.ByteString)++mkSource :: IO S.ByteString -> IO Source+mkSource f = do+    ref <- newIORef S.empty+    return $ Source f ref++readSource :: Source -> IO S.ByteString+readSource (Source f ref) = do+    bs <- atomicModifyIORef ref $ \bs -> (S.empty, bs)+    if S.null bs+        then f+        else return bs++leftover :: Source -> S.ByteString -> IO ()+leftover (Source _ ref) bs = writeIORef ref bs++parsePieces :: BackEnd y+            -> S.ByteString+            -> IO S.ByteString+            -> (Either Param (File y) -> IO ())+            -> IO ()+parsePieces sink bound rbody add =+    mkSource rbody >>= loop+  where+    loop src = do+        _boundLine <- takeLine src+        res' <- takeLines src+        unless (null res') $ do+            let ls' = map parsePair res'+            let x = do+                    cd <- lookup contDisp ls'+                    let ct = lookup contType ls'+                    let attrs = parseAttrs cd+                    name <- lookup "name" attrs+                    return (ct, name, lookup "filename" attrs)+            case x of+                Just (mct, name, Just filename) -> do+                    let ct = fromMaybe "application/octet-stream" mct+                        fi0 = FileInfo filename ct ()+                    (wasFound, y) <- sinkTillBound' bound name fi0 sink src+                    add $ Right (name, fi0 { fileContent = y })+                    when wasFound (loop src)+                Just (_ct, name, Nothing) -> do+                    let seed = id+                    let iter front bs = return $ front . (:) bs+                    (wasFound, front) <- sinkTillBound bound iter seed src+                    let bs = S.concat $ front []+                    let x' = (name, bs)+                    add $ Left x'+                    when wasFound (loop src)+                _ -> do+                    -- ignore this part+                    let seed = ()+                        iter () _ = return ()+                    (wasFound, ()) <- sinkTillBound bound iter seed src+                    when wasFound (loop src)+      where+        contDisp = S8.pack "Content-Disposition"+        contType = S8.pack "Content-Type"+        parsePair s =+            let (x, y) = breakDiscard 58 s -- colon+             in (x, S.dropWhile (== 32) y) -- space++data Bound = FoundBound S.ByteString S.ByteString+           | NoBound+           | PartialBound+    deriving (Eq, Show)++findBound :: S.ByteString -> S.ByteString -> Bound+findBound b bs = handleBreak $ Search.breakOn b bs+  where+    handleBreak (h, t)+        | S.null t = go [lowBound..S.length bs - 1]+        | otherwise = FoundBound h $ S.drop (S.length b) t++    lowBound = max 0 $ S.length bs - S.length b++    go [] = NoBound+    go (i:is)+        | mismatch [0..S.length b - 1] [i..S.length bs - 1] = go is+        | otherwise =+            let endI = i + S.length b+             in if endI > S.length bs+                    then PartialBound+                    else FoundBound (S.take i bs) (S.drop endI bs)+    mismatch [] _ = False+    mismatch _ [] = False+    mismatch (x:xs) (y:ys)+        | S.index b x == S.index bs y = mismatch xs ys+        | otherwise = True++sinkTillBound' :: S.ByteString+               -> S.ByteString+               -> FileInfo ()+               -> BackEnd y+               -> Source+               -> IO (Bool, y)+sinkTillBound' bound name fi sink src = do+    (next, final) <- wrapTillBound bound src+    y <- sink name fi next+    b <- final+    return (b, y)++data WTB = WTBWorking (S.ByteString -> S.ByteString)+         | WTBDone Bool+wrapTillBound :: S.ByteString -- ^ bound+              -> Source+              -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found+wrapTillBound bound src = do+    ref <- newIORef $ WTBWorking id+    return (go ref, final ref)+  where+    final ref = do+        x <- readIORef ref+        case x of+            WTBWorking _ -> error "wrapTillBound did not finish"+            WTBDone y -> return y++    go ref = do+        state <- readIORef ref+        case state of+            WTBDone _ -> return S.empty+            WTBWorking front -> do+                bs <- readSource src+                if S.null bs+                    then do+                        writeIORef ref $ WTBDone False+                        return $ front bs+                    else push $ front bs+      where+        push bs =+            case findBound bound bs of+                FoundBound before after -> do+                    let before' = killCRLF before+                    leftover src after+                    writeIORef ref $ WTBDone True+                    return before'+                NoBound -> do+                    -- don't emit newlines, in case it's part of a bound+                    let (toEmit, front') =+                            if not (S8.null bs) && S8.last bs `elem` "\r\n"+                                then let (x, y) = S.splitAt (S.length bs - 2) bs+                                      in (x, S.append y)+                                else (bs, id)+                    writeIORef ref $ WTBWorking front'+                    if S.null toEmit+                        then go ref+                        else return toEmit+                PartialBound -> do+                    writeIORef ref $ WTBWorking $ S.append bs+                    go ref++sinkTillBound :: S.ByteString+              -> (x -> S.ByteString -> IO x)+              -> x+              -> Source+              -> IO (Bool, x)+sinkTillBound bound iter seed0 src = do+    (next, final) <- wrapTillBound bound src+    let loop seed = do+            bs <- next+            if S.null bs+                then return seed+                else iter seed bs >>= loop+    seed <- loop seed0+    b <- final+    return (b, seed)++parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]+parseAttrs = map go . S.split 59 -- semicolon+  where+    tw = S.dropWhile (== 32) -- space+    dq s = if S.length s > 2 && S.head s == 34 && S.last s == 34 -- quote+                then S.tail $ S.init s+                else s+    go s =+        let (x, y) = breakDiscard 61 s -- equals sign+         in (tw x, dq $ tw y)++killCRLF :: S.ByteString -> S.ByteString+killCRLF bs+    | S.null bs || S.last bs /= 10 = bs -- line feed+    | otherwise = killCR $ S.init bs++killCR :: S.ByteString -> S.ByteString+killCR bs+    | S.null bs || S.last bs /= 13 = bs -- carriage return+    | otherwise = S.init bs

@@ -7,7 +7,7 @@      -- | Method(..)     , module Data.Apiary.Method-    -- | Has, MonadHas, Extensions, Initializer, Initializer', (+>)+    -- | Has, MonadHas, Extensions, Initializer, Initializer', (+>), noExtension     , module Data.Apiary.Extension     -- | key, Member, Members, NotMember, Elem((:=))     , module Data.Apiary.Dict@@ -63,6 +63,7 @@     , redirect, redirectPermanently, redirectTemporary     , defaultDocumentationAction     , DefaultDocumentConfig(..)+    , hoistActionT     )  import Control.Monad.Apiary.Filter@@ -87,7 +88,7 @@     )  import Data.Apiary.Method(Method(..))-import Data.Apiary.Extension(Has, MonadExts(..), getExt, Extensions, Initializer, Initializer', (+>))+import Data.Apiary.Extension(Has, MonadExts(..), getExt, Extensions, Initializer, Initializer', (+>), noExtension) import Data.Apiary.Dict(key, Member, Members, NotMember, Elem((:=)))  import Network.HTTP.Types.Status hiding (mkStatus)