apiary 0.13.0 → 0.14.0

raw patch · 20 files changed

+638/−477 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• apiary.cabal +8/−5
• src/Control/Monad/Apiary.hs +3/−2
• src/Control/Monad/Apiary/Action.hs +5/−9
• src/Control/Monad/Apiary/Action/Internal.hs +137/−112
• src/Control/Monad/Apiary/Filter.hs +40/−37
• src/Control/Monad/Apiary/Filter/Internal.hs +3/−1
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +4/−4
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +13/−4
• src/Control/Monad/Apiary/Filter/Internal/Strategy.hs +14/−23
• src/Control/Monad/Apiary/Internal.hs +71/−63
• src/Data/Apiary/Document.hs +47/−175
• src/Data/Apiary/Document/Html.hs +169/−0
• src/Data/Apiary/Method.hs +39/−0
• src/Data/Apiary/Param.hs +23/−27
• src/Data/Apiary/Proxy.hs +20/−0
• src/Web/Apiary.hs +15/−4
• src/Web/Apiary/TH.hs +7/−3
• static/api-documentation.min.css +1/−1
• test/main.hs +7/−7

@@ -1,3 +1,15 @@+# 0.14.0+* change First Strategy behaviour(check first param only).+* merge method and stdMethod function.+* rename function (response -> rawResponse)+* add apiary-purescript++## documentation+* changed how to generate documentation. use defaultDocumentationAction action.+* now, condition which is after document function, will be documented. use noDoc function.+* abolish ':' query document api. use (??) function.+* deprecated () route decument api. use [].+ # 0.13.0 * Option that generate full embed documentation. * Add precondition, rpHtml functions.

@@ -1,5 +1,5 @@ name:                apiary-version:             0.13.0+version:             0.14.0 synopsis:            Simple and type safe web framework that can be automatically generate API documentation. description:   Simple and type safe web framework that can be automatically generate API documentation.@@ -14,7 +14,7 @@   .   main :: IO ()   main = run 3000 . runApiary def $ do-  &#32;&#32;[capture|/:Int|] . (&#34;name&#34; =: pLazyByteString) . stdMethod GET . action $ \\age name -> do+  &#32;&#32;[capture|/:Int|] . (&#34;name&#34; =: pLazyByteString) . method GET . action $ \\age name -> do   &#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;lbs . L.concat $ [&#34;&#60;h1&#62;Hello, &#34;, name, &#34;!&#60;/h1&#62;\\n&#34;]@@ -31,13 +31,13 @@   404 Page Notfound.   @   .-    * Nestable route handling(Apiary Monad; capture, stdMethod and more.).+    * Nestable route handling(Apiary Monad; capture, method and more.).   .     * type safe route filter.   .-    * auto generate API documentation(example: <https://github.com/philopon/apiary/blob/v0.13.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v0.13.0/examples/api.html>).+    * auto generate API documentation(example: <https://github.com/philopon/apiary/blob/v0.14.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v0.14.0/examples/api.html>).   .-  more examples: <https://github.com/philopon/apiary/blob/v0.13.0/examples/>+  more examples: <https://github.com/philopon/apiary/blob/v0.14.0/examples/>  license:             MIT license-file:        LICENSE@@ -74,7 +74,10 @@                         Data.Apiary.SList                        Data.Apiary.Param+                       Data.Apiary.Method+                       Data.Apiary.Proxy                        Data.Apiary.Document+                       Data.Apiary.Document.Html    other-modules:       Control.Monad.Apiary.Internal                        Control.Monad.Apiary.Action.Internal

@@ -2,7 +2,6 @@     ( ApiaryT, Apiary     , runApiary     , runApiaryT-    , runApiaryT'     -- * getter     , apiaryConfig     -- * execute action@@ -11,10 +10,12 @@     , group     , document     , precondition+    , noDoc     , rpHtml     -- * deprecated     , actionWithPreAction     ) where  import Control.Monad.Apiary.Internal-import Data.Apiary.Document (rpHtml)++import Data.Apiary.Document.Html (rpHtml)

@@ -12,6 +12,7 @@     , getRequest     , getHeaders     , getReqParams+    , File(..)     , getReqFiles      -- ** setter@@ -21,13 +22,12 @@     , ContentType     , contentType     -- *** response body-    , File(..)     , file     , file'     , builder     , lbs     , stream-    , response+    , rawResponse      , StreamingBody @@ -35,19 +35,15 @@     -- *** redirect     , redirect, redirectPermanently, redirectTemporary     , redirectWith-    -- * Reexport-    , module Data.Default.Class-    , module Network.HTTP.Types.Status-    +        -- * deprecated     , redirectFound, redirectSeeOther, source     ) where  import Control.Monad.Apiary.Action.Internal-import Data.Default.Class+ import Data.Apiary.Param-import Data.Apiary.Document-import Network.HTTP.Types.Status hiding (mkStatus)+import Data.Apiary.Document.Html  #ifdef WAI3 import Network.Wai

@@ -21,14 +21,16 @@ import Control.Monad.Catch import Control.Monad.Trans.Control -import Network.Wai-import qualified Network.Wai.Parse as P import Network.Mime import Network.HTTP.Types+import Network.Wai+import qualified Network.Wai.Parse as P  import Data.Apiary.Param import Data.Apiary.Document+import Data.Apiary.Document.Html import Data.Default.Class+ import Blaze.ByteString.Builder import Text.Blaze.Html.Renderer.Utf8 import qualified Data.ByteString as S@@ -38,6 +40,7 @@  #ifndef WAI3 import Data.Conduit+type StreamingBody = Source IO (Flush Builder) #endif  data ApiaryConfig = ApiaryConfig@@ -52,38 +55,33 @@       -- | used by 'Control.Monad.Apiary.Filter.root' filter.     , rootPattern         :: [S.ByteString]     , mimeType            :: FilePath -> S.ByteString-    , documentationAction :: Maybe (Documents -> ActionT IO ())     } -defaultDocumentationAction :: Monad m => S.ByteString -> DefaultDocumentConfig -> Documents -> ActionT m ()-defaultDocumentationAction r conf d = do-    p <- rawPathInfo <$> getRequest-    guard $ p == r+defaultDocumentationAction :: Monad m => DefaultDocumentConfig -> ActionT m ()+defaultDocumentationAction conf = do+    d <- getDocuments     contentType "text/html"     builder . renderHtmlBuilder $ defaultDocumentToHtml conf d -defNotFound :: Application+defaultNotFound :: Application #ifdef WAI3-defNotFound _ f = f      $ responseLBS status404 [("Content-Type", "text/plain")] "404 Page Notfound.\n"+defaultNotFound _ f = f      $ responseLBS status404 [("Content-Type", "text/plain")] "404 Page Notfound.\n" #else-defNotFound _   = return $ responseLBS status404 [("Content-Type", "text/plain")] "404 Page Notfound.\n"+defaultNotFound _   = return $ responseLBS status404 [("Content-Type", "text/plain")] "404 Page Notfound.\n" #endif  instance Default ApiaryConfig where     def = ApiaryConfig -        { notFound            = defNotFound+        { notFound            = defaultNotFound         , defaultStatus       = ok200         , defaultHeaders      = []         , failStatus          = internalServerError500         , failHeaders         = []         , rootPattern         = ["", "/", "/index.html", "/index.htm"]         , mimeType            = defaultMimeLookup . T.pack-        , documentationAction = Just $ defaultDocumentationAction-            "/api/documentation" def         } -convFile :: (S.ByteString, P.FileInfo L.ByteString) -> File-convFile (p, P.FileInfo{..}) = File p fileName fileContentType fileContent+--------------------------------------------------------------------------------  data ActionState = ActionState     { actionResponse :: Response@@ -101,80 +99,39 @@     , actionReqBody  = Nothing     , actionPathInfo = pathInfo req     }+{-# INLINE initialState #-} -#ifndef WAI3-type StreamingBody = Source IO (Flush Builder)-#endif+-------------------------------------------------------------------------------- +data ActionEnv = ActionEnv+    { actionConfig    :: ApiaryConfig+    , actionRequest   :: Request+    , actionDocuments :: Documents+    }+ data Action a      = Continue a     | Pass     | Stop Response  newtype ActionT m a = ActionT { unActionT :: forall b. -    ApiaryConfig-    -> Request+    ActionEnv     -> ActionState     -> (a -> ActionState -> m (Action b))     -> m (Action b)     } -instance Functor (ActionT m) where-    fmap f m = ActionT $ \conf req st cont ->-        unActionT m conf req st (\a s' -> s' `seq` cont (f a) s')--instance Applicative (ActionT m) where-    pure x = ActionT $ \_ _ st cont -> cont x st-    mf <*> ma = ActionT $ \conf req st cont ->-        unActionT mf conf req st  $ \f st'  ->-        unActionT ma conf req st' $ \a st'' ->-        st' `seq` st'' `seq` cont (f a) st''--instance Monad m => Monad (ActionT m) where-    return x = ActionT $ \_ _ st cont -> cont x st-    m >>= k  = ActionT $ \conf req st cont ->-        unActionT m conf req st $ \a st' ->-        st' `seq` unActionT (k a) conf req st' cont-    fail s = ActionT $ \c _ _ _ -> return $-        Stop (responseLBS (failStatus c) (failHeaders c) $ LC.pack s)--instance MonadIO m => MonadIO (ActionT m) where-    liftIO m = ActionT $ \_ _ st cont ->-        liftIO m >>= \a -> cont a st--instance MonadTrans ActionT where-    lift m = ActionT $ \_ _ st cont ->-        m >>= \a -> cont a st--instance MonadThrow m => MonadThrow (ActionT m) where-    throwM e = ActionT $ \_ _ st cont ->-        throwM e >>= \a -> cont a st--instance MonadCatch m => MonadCatch (ActionT m) where-    catch m h = actionT $ \conf req st -> -        catch (runActionT m conf req st) (\e -> runActionT (h e) conf req st)--instance MonadMask m => MonadMask (ActionT m) where-    mask a = actionT $ \conf req st ->-        mask $ \u -> runActionT (a $ q u) conf req st-      where-        q u m = actionT $ \conf req st -> u (runActionT m conf req st)-    uninterruptibleMask a = actionT $ \conf req st ->-        uninterruptibleMask $ \u -> runActionT (a $ q u) conf req st-      where-        q u m = actionT $ \conf req st -> u (runActionT m conf req st)- runActionT :: Monad m => ActionT m a-           -> ApiaryConfig -> Request -> ActionState+           -> ActionEnv -> ActionState            -> m (Action (a, ActionState))-runActionT m conf req st = unActionT m conf req st $ \a st' ->+runActionT m env st = unActionT m env st $ \a st' ->     st' `seq` return (Continue (a, st')) {-# INLINE runActionT #-}  actionT :: Monad m -        => (ApiaryConfig -> Request -> ActionState -> m (Action (a, ActionState)))+        => (ActionEnv -> ActionState -> m (Action (a, ActionState)))         -> ActionT m a-actionT f = ActionT $ \conf req st cont -> f conf req st >>= \case+actionT f = ActionT $ \env st cont -> f env st >>= \case     Pass             -> return Pass     Stop s           -> return $ Stop s     Continue (a,st') -> st' `seq` cont a st'@@ -183,16 +140,16 @@ -- | n must be Monad, so cant be MFunctor. hoistActionT :: (Monad m, Monad n)              => (forall b. m b -> n b) -> ActionT m a -> ActionT n a-hoistActionT run m = actionT $ \c r s -> run (runActionT m c r s)--execActionT :: ApiaryConfig -> ActionT IO () -> Application+hoistActionT run m = actionT $ \e s -> run (runActionT m e s)+{-# INLINE hoistActionT #-} +execActionT :: ApiaryConfig -> Documents -> ActionT IO () -> Application #ifdef WAI3-execActionT config m request send = +execActionT config doc m request send =  #else-execActionT config m request = let send = return in+execActionT config doc m request = let send = return in #endif-    runActionT m config request (initialState config request) >>= \case+    runActionT m (ActionEnv config request doc) (initialState config request) >>= \case #ifdef WAI3         Pass           -> notFound config request send #else@@ -201,25 +158,79 @@         Stop s         -> send s         Continue (_,r) -> send $ actionResponse r +--------------------------------------------------------------------------------++instance Functor (ActionT m) where+    fmap f m = ActionT $ \env st cont ->+        unActionT m env st (\a s' -> s' `seq` cont (f a) s')++instance Applicative (ActionT m) where+    pure x = ActionT $ \_ st cont -> cont x st+    mf <*> ma = ActionT $ \env st cont ->+        unActionT mf env st  $ \f st'  ->+        unActionT ma env st' $ \a st'' ->+        st' `seq` st'' `seq` cont (f a) st''++instance Monad m => Monad (ActionT m) where+    return x = ActionT $ \_ st cont -> cont x st+    m >>= k  = ActionT $ \env st cont ->+        unActionT m env st $ \a st' ->+        st' `seq` unActionT (k a) env st' cont+    fail s = ActionT $ \(ActionEnv{actionConfig = c}) _ _ -> return $+        Stop (responseLBS (failStatus c) (failHeaders c) $ LC.pack s)++instance MonadIO m => MonadIO (ActionT m) where+    liftIO m = ActionT $ \_ st cont ->+        liftIO m >>= \a -> cont a st++instance MonadTrans ActionT where+    lift m = ActionT $ \_ st cont ->+        m >>= \a -> cont a st++instance MonadThrow m => MonadThrow (ActionT m) where+    throwM e = ActionT $ \_ st cont ->+        throwM e >>= \a -> cont a st++instance MonadCatch m => MonadCatch (ActionT m) where+    catch m h = actionT $ \env st -> +        catch (runActionT m env st) (\e -> runActionT (h e) env st)+    {-# INLINE catch #-}++instance MonadMask m => MonadMask (ActionT m) where+    mask a = actionT $ \env st ->+        mask $ \u -> runActionT (a $ q u) env st+      where+        q u m = actionT $ \env st -> u (runActionT m env st)+    uninterruptibleMask a = actionT $ \env st ->+        uninterruptibleMask $ \u -> runActionT (a $ q u) env st+      where+        q u m = actionT $ \env st -> u (runActionT m env st)+    {-# INLINE mask #-}+    {-# INLINE uninterruptibleMask #-}+ instance (Monad m, Functor m) => Alternative (ActionT m) where     empty = mzero     (<|>) = mplus+    {-# INLINE empty #-}+    {-# INLINE (<|>) #-}  instance Monad m => MonadPlus (ActionT m) where-    mzero = actionT $ \_ _ _ -> return Pass-    mplus m n = actionT $ \c r s -> runActionT m c r s >>= \case+    mzero = actionT $ \_ _ -> return Pass+    mplus m n = actionT $ \e s -> runActionT m e s >>= \case         Continue a -> return $ Continue a         Stop stp   -> return $ Stop stp-        Pass       -> runActionT n c r s+        Pass       -> runActionT n e s+    {-# INLINE mzero #-}+    {-# INLINE mplus #-}  instance MonadBase b m => MonadBase b (ActionT m) where     liftBase = liftBaseDefault  instance MonadTransControl ActionT where     newtype StT ActionT a = StActionT { unStActionT :: Action (a, ActionState) }-    liftWith f = actionT $ \c r s -> -        liftM (\a -> Continue (a,s)) (f $ \t -> liftM StActionT $ runActionT t c r s)-    restoreT m = actionT $ \_ _ _ -> liftM unStActionT m+    liftWith f = actionT $ \e s -> +        liftM (\a -> Continue (a,s)) (f $ \t -> liftM StActionT $ runActionT t e s)+    restoreT m = actionT $ \_ _ -> liftM unStActionT m  instance MonadBaseControl b m => MonadBaseControl b (ActionT m) where     newtype StM (ActionT m) a = StMT { unStMT :: ComposeSt ActionT m a }@@ -230,25 +241,30 @@     ask     = lift ask     local f = hoistActionT $ local f --- | stop handler and send current state. since 0.3.3.0.-stop :: Monad m => ActionT m a-stop = ActionT $ \_ _ s _ -> return $ Stop (actionResponse s)+-------------------------------------------------------------------------------- --- | stop with response. since 0.4.2.0.-stopWith :: Monad m => Response -> ActionT m a-stopWith a = ActionT $ \_ _ _ _ -> return $ Stop a+getEnv :: Monad m => ActionT m ActionEnv+getEnv = ActionT $ \e s c -> c e s  -- | get raw request. since 0.1.0.0. getRequest :: Monad m => ActionT m Request-getRequest = ActionT $ \_ r s c -> c r s+getRequest = liftM actionRequest getEnv +getConfig :: Monad m => ActionT m ApiaryConfig+getConfig = liftM actionConfig getEnv++getDocuments :: Monad m => ActionT m Documents+getDocuments = liftM actionDocuments getEnv+ getRequestBody :: MonadIO m => ActionT m ([Param], [File])-getRequestBody = ActionT $ \_ r s c -> case actionReqBody s of+getRequestBody = ActionT $ \e s c -> case actionReqBody s of     Just b  -> c b s     Nothing -> do-        (p,f) <- liftIO $ P.parseRequestBody P.lbsBackEnd r+        (p,f) <- liftIO $ P.parseRequestBody P.lbsBackEnd (actionRequest e)         let b = (p, map convFile f)         c b s { actionReqBody = Just b }+  where+    convFile (p, P.FileInfo{..}) = File p fileName fileContentType fileContent  -- | parse request body and return params. since 0.9.0.0. getReqParams :: MonadIO m => ActionT m [Param]@@ -258,23 +274,22 @@ getReqFiles :: MonadIO m => ActionT m [File] getReqFiles = snd <$> getRequestBody -getConfig :: Monad m => ActionT m ApiaryConfig-getConfig = ActionT $ \c _ s cont -> cont c s+--------------------------------------------------------------------------------  modifyState :: Monad m => (ActionState -> ActionState) -> ActionT m ()-modifyState f = ActionT $ \_ _ s c -> c () (f s)+modifyState f = ActionT $ \_ s c -> c () (f s)  getState :: ActionT m ActionState-getState = ActionT $ \_ _ s c -> c s s---- | get all request headers. since 0.6.0.0.-getHeaders :: Monad m => ActionT m RequestHeaders-getHeaders = requestHeaders `liftM` getRequest+getState = ActionT $ \_ s c -> c s s  -- | set status code. since 0.1.0.0. status :: Monad m => Status -> ActionT m () status st = modifyState (\s -> s { actionStatus = st } ) +-- | get all request headers. since 0.6.0.0.+getHeaders :: Monad m => ActionT m RequestHeaders+getHeaders = requestHeaders `liftM` getRequest+ -- | modify response header. since 0.1.0.0. modifyHeader :: Monad m => (ResponseHeaders -> ResponseHeaders) -> ActionT m () modifyHeader f = modifyState (\s -> s {actionHeaders = f $ actionHeaders s } )@@ -295,6 +310,16 @@ contentType c = modifyHeader     (\h -> ("Content-Type", c) : filter (("Content-Type" /=) . fst) h) +--------------------------------------------------------------------------------++-- | stop handler and send current state. since 0.3.3.0.+stop :: Monad m => ActionT m a+stop = ActionT $ \_ s _ -> return $ Stop (actionResponse s)++-- | stop with response. since 0.4.2.0.+stopWith :: Monad m => Response -> ActionT m a+stopWith a = ActionT $ \_ _ _ -> return $ Stop a+ -- | redirect handler -- -- set status and add location header. since 0.3.3.0.@@ -347,13 +372,6 @@         then redirectWith temporaryRedirect307 to         else redirectWith status302            to --- | set response body file content and detect Content-Type by extension. since 0.1.0.0.-file :: Monad m => FilePath -> Maybe FilePart -> ActionT m ()-file f p = do-    mime <- mimeType <$> getConfig-    contentType (mime f)-    file' f p- -- | Raw response constructor. since 0.10. -- -- example(use pipes-wai)@@ -363,27 +381,34 @@ -- producer = response (\s h -> responseProducer s h) -- @ ---response :: Monad m => (Status -> ResponseHeaders -> Response) -> ActionT m ()-response f = modifyState (\s -> s { actionResponse = f (actionStatus s) (actionHeaders s)} )+rawResponse :: Monad m => (Status -> ResponseHeaders -> Response) -> ActionT m ()+rawResponse f = modifyState (\s -> s { actionResponse = f (actionStatus s) (actionHeaders s)} )  -- | set response body file content, without set Content-Type. since 0.1.0.0. file' :: Monad m => FilePath -> Maybe FilePart -> ActionT m ()-file' f p = response (\s h -> responseFile s h f p)+file' f p = rawResponse (\s h -> responseFile s h f p) +-- | set response body file content and detect Content-Type by extension. since 0.1.0.0.+file :: Monad m => FilePath -> Maybe FilePart -> ActionT m ()+file f p = do+    mime <- mimeType <$> getConfig+    contentType (mime f)+    file' f p+ -- | set response body builder. since 0.1.0.0. builder :: Monad m => Builder -> ActionT m ()-builder b = response (\s h -> responseBuilder s h b)+builder b = rawResponse (\s h -> responseBuilder s h b)  -- | set response body lazy bytestring. since 0.1.0.0. lbs :: Monad m => L.ByteString -> ActionT m ()-lbs l = response (\s h -> responseLBS s h l)+lbs l = rawResponse (\s h -> responseLBS s h l)  -- | set response body source. since 0.9.0.0. stream :: Monad m => StreamingBody -> ActionT m () #ifdef WAI3-stream str = response (\s h -> responseStream s h str)+stream str = rawResponse (\s h -> responseStream s h str) #else-stream str = response (\s h -> responseSource s h str)+stream str = rawResponse (\s h -> responseSource s h str) #endif  {-# DEPRECATED source "use stream" #-}

@@ -7,11 +7,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}  module Control.Monad.Apiary.Filter (     -- * filters     -- ** http method-      method, stdMethod+      method, Method(..)     -- ** http version     , Control.Monad.Apiary.Filter.httpVersion     , http09, http10, http11@@ -39,46 +40,50 @@     -- ** other     , ssl     -    -- * Reexport-    -- | StdMethod(..)-    , module Network.HTTP.Types-    -- | Strategy Proxies-    , module Control.Monad.Apiary.Filter.Internal.Strategy+    -- * deprecated+    , stdMethod      ) where -import Control.Monad-import Control.Monad.Trans import Network.Wai as Wai import qualified Network.HTTP.Types as HT-import Network.HTTP.Types (StdMethod(..))++import Control.Monad+import Control.Monad.Trans++import Control.Monad.Apiary.Action.Internal+import Control.Monad.Apiary.Filter.Internal+import Control.Monad.Apiary.Filter.Internal.Capture.TH+import Control.Monad.Apiary.Internal+import qualified Control.Monad.Apiary.Filter.Internal.Strategy as Strategy+import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture++import Text.Blaze.Html import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as SC import Data.Monoid import Data.Proxy import Data.String import Data.Reflection-import Text.Blaze.Html  import Data.Apiary.SList import Data.Apiary.Param import Data.Apiary.Document--import Control.Monad.Apiary.Action.Internal-import Control.Monad.Apiary.Filter.Internal-import qualified Control.Monad.Apiary.Filter.Internal.Strategy as Strategy-import Control.Monad.Apiary.Filter.Internal.Strategy (pFirst, pOne, pOption, pCheck, pMany, pSome)-import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture-import Control.Monad.Apiary.Filter.Internal.Capture.TH-import Control.Monad.Apiary.Internal+import Data.Apiary.Method  -- | filter by HTTP method. since 0.1.0.0.-method :: Monad n => HT.Method -> ApiaryT c n m a -> ApiaryT c n m a-method m = function_ (DocMethod m) ((m ==) . requestMethod)+--+-- @+-- method GET      -- stdmethod+-- method \"HOGE\" -- non standard method+-- @+method :: Monad n => Method -> ApiaryT c n m a -> ApiaryT c n m a+method m = function_ (DocMethod m) ((renderMethod m ==) . requestMethod) +{-# DEPRECATED stdMethod "use method" #-} -- | filter by HTTP method using StdMethod. since 0.1.0.0.-stdMethod :: Monad n => StdMethod -> ApiaryT c n m a -> ApiaryT c n m a-stdMethod = method . HT.renderStdMethod+stdMethod :: Monad n => Method -> ApiaryT c n m a -> ApiaryT c n m a+stdMethod = method  -- | filter by ssl accessed. since 0.1.0.0. ssl :: Monad n => ApiaryT c n m a -> ApiaryT c n m a@@ -106,15 +111,15 @@     rs <- rootPattern `liftM` apiaryConfig     function_ DocRoot (\r -> rawPathInfo r `elem` rs) m +--------------------------------------------------------------------------------+ data QueryKey = QueryKey     { queryKey  :: S.ByteString     , queryDesc :: Maybe Html     }  instance IsString QueryKey where-    fromString s = case break (== ':') s of-        (k, []) -> QueryKey (SC.pack k) Nothing-        (k, d)  -> QueryKey (SC.pack k) (Just . toHtml $ tail d)+    fromString s = QueryKey (SC.pack s) Nothing  (??) :: QueryKey -> Html -> QueryKey QueryKey k _ ?? d = QueryKey k (Just d)@@ -147,9 +152,7 @@             Strategy.readStrategy id ((queryKey ==) . fst) p              (reqParams (Proxy :: Proxy a) r q f) l   where-    doc = case queryDesc of-        Nothing -> id-        Just h  -> DocQuery queryKey (Strategy.strategyRep (Proxy :: Proxy w)) (reqParamRep (Proxy :: Proxy a)) h+    doc = DocQuery queryKey (Strategy.strategyRep (Proxy :: Proxy w)) (reqParamRep (Proxy :: Proxy a)) queryDesc  -- | get first matched paramerer. since 0.5.0.0. --@@ -158,7 +161,7 @@ -- @ (=:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a       -> ApiaryT (Snoc as a) n m b -> ApiaryT as n m b-k =: t = query k (pFirst t)+k =: t = query k (Strategy.pFirst t)  -- | get one matched paramerer. since 0.5.0.0. --@@ -169,7 +172,7 @@ -- @ (=!:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a        -> ApiaryT (Snoc as a) n m b -> ApiaryT as n m b-k =!: t = query k (pOne t)+k =!: t = query k (Strategy.pOne t)  -- | get optional first paramerer. since 0.5.0.0. --@@ -180,7 +183,7 @@ -- @ (=?:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a        -> ApiaryT (Snoc as (Maybe a)) n m b -> ApiaryT as n m b-k =?: t = query k (pOption t)+k =?: t = query k (Strategy.pOption t)  -- | check parameger given and type. since 0.5.0.0. --@@ -191,7 +194,7 @@ -- @ (?:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a       -> ApiaryT as n m b -> ApiaryT as n m b-k ?: t = query k (pCheck t)+k ?: t = query k (Strategy.pCheck t)  -- | get many paramerer. since 0.5.0.0. --@@ -200,7 +203,7 @@ -- @ (=*:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a        -> ApiaryT (Snoc as [a]) n m b -> ApiaryT as n m b-k =*: t = query k (pMany t)+k =*: t = query k (Strategy.pMany t)  -- | get some paramerer. since 0.5.0.0. --@@ -209,7 +212,7 @@ -- @ (=+:) :: (MonadIO n, ReqParam a) => QueryKey -> proxy a        -> ApiaryT (Snoc as [a]) n m b -> ApiaryT as n m b-k =+: t = query k (pSome t)+k =+: t = query k (Strategy.pSome t)  -- | query exists checker. --@@ -224,7 +227,7 @@  -- | check whether to exists specified header or not. since 0.6.0.0. hasHeader :: Monad n => HT.HeaderName -> ApiaryT as n m b -> ApiaryT as n m b-hasHeader n = header' pCheck ((n ==) . fst) . Just $+hasHeader n = header' Strategy.pCheck ((n ==) . fst) . Just $     toHtml (show n) <> " header requred"  -- | check whether to exists specified valued header or not. since 0.6.0.0.@@ -233,13 +236,13 @@          -> S.ByteString  -- ^ header value          -> ApiaryT as n m b          -> ApiaryT as n m b-eqHeader k v = header' pCheck (\(k',v') -> k == k' && v == v') . Just $+eqHeader k v = header' Strategy.pCheck (\(k',v') -> k == k' && v == v') . Just $     mconcat [toHtml $ show k, " header == ", toHtml $ show v]  -- | filter by header and get first. since 0.6.0.0. header :: Monad n => HT.HeaderName        -> ApiaryT (Snoc as S.ByteString) n m b -> ApiaryT as n m b-header n = header' pFirst ((n ==) . fst) . Just $+header n = header' Strategy.pFirst ((n ==) . fst) . Just $     toHtml (show n) <> " header requred"  -- | filter by headers up to 100 entries. since 0.6.0.0.

@@ -2,10 +2,12 @@     ( function, function', function_, focus     ) where +import Network.Wai+ import Control.Monad import Control.Monad.Apiary.Internal import Control.Monad.Apiary.Action-import Network.Wai+ import Data.Apiary.SList import Data.Apiary.Document 

@@ -15,15 +15,15 @@  import Control.Applicative import Control.Monad-import qualified Data.Text as T-import Text.Blaze.Html+import Control.Monad.Apiary.Action.Internal+import Control.Monad.Apiary.Internal  import Data.Apiary.Param import Data.Apiary.SList import Data.Apiary.Document -import Control.Monad.Apiary.Action.Internal-import Control.Monad.Apiary.Internal+import qualified Data.Text as T+import Text.Blaze.Html  -- | check first path and drill down. since 0.11.0. path :: Monad n => T.Text -> ApiaryT c n m a -> ApiaryT c n m a

@@ -6,7 +6,9 @@  import Language.Haskell.TH import Language.Haskell.TH.Quote+ import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture+ import qualified Data.Text as T import Data.Proxy @@ -22,12 +24,19 @@ data Lookup = N Name | S String | None  description :: String -> Q (String, Lookup)-description s = case break (== '(') s of+description s = case break (`elem` "([") s of     (t, []) -> return (t, None)-    (t, st) -> case break (== ')') st of-        (_:'$':b, ")") -> lookupValueName b >>=+    (t, st) -> case break (`elem` ")]") st of+        (_:'$':b, ")") -> do+            reportWarning "DEPRECATED () description. use []."+            s <- lookupValueName b+            maybe (fail $ b ++ " not found.") (return . (t,) . N) s+        (_:b,     ")") -> do+            reportWarning "DEPRECATED () description. use []."+            return (t, S b)+        (_:'$':b, "]") -> lookupValueName b >>=             maybe (fail $ b ++ " not found.") (return . (t,) . N)-        (_:b,     ")") -> return (t, S b)+        (_:b,     "]") -> return (t, S b)         (_, _)         -> fail "capture: syntax error."   mkCap :: [String] -> ExpQ

@@ -12,17 +12,14 @@  module Control.Monad.Apiary.Filter.Internal.Strategy where -import Data.Apiary.SList-import qualified Data.Text as T-import Data.Apiary.Document--import Data.Typeable import Data.Maybe import Data.Reflection-#if __GLASGOW_HASKELL__ < 707-import Data.Proxy-#endif+import qualified Data.Text as T +import Data.Apiary.Proxy+import Data.Apiary.SList+import Data.Apiary.Document+ class Strategy (w :: * -> *) where     type SNext w (as :: [*]) a  :: [*]     readStrategy :: (v -> Maybe a)@@ -36,7 +33,7 @@ getQuery :: (v -> Maybe a) -> proxy (w a) -> ((k,v) -> Bool) -> [(k, v)] -> [Maybe a] getQuery readf _ kf = map readf . map snd . filter kf --- | get first matched key( [1,) params to Type.). since 0.5.0.0.+-- | get first matched key( [0,) params to Type.). since 0.5.0.0. data Option a deriving Typeable instance Strategy Option where     type SNext Option as a = Snoc as (Maybe a)@@ -49,30 +46,24 @@                a:_ -> Just a     strategyRep _ = StrategyRep "optional" --- | get first matched key ( [0,) params to Maybe Type.) since 0.5.0.0.+-- | get first matched key ( [1,) params to Maybe Type.) since 0.5.0.0. data First a deriving Typeable instance Strategy First where     type SNext First as a = Snoc as a     readStrategy rf k p q l =-        let rs = getQuery rf p k q-        in if any isNothing rs-           then Nothing-           else case catMaybes rs of-               [] -> Nothing-               a:_ -> Just $ sSnoc l a+        case getQuery rf p k q of+            Just a:_ -> Just $ sSnoc l a+            _        -> Nothing     strategyRep _ = StrategyRep "first" --- | get key ( [1] param to Type.) since 0.5.0.0.+-- | get key ( [1,1] param to Type.) since 0.5.0.0. data One a deriving Typeable instance Strategy One where     type SNext One as a = Snoc as a     readStrategy rf k p q l =-        let rs = getQuery rf p k q-        in if any isNothing rs-           then Nothing-           else case catMaybes rs of-               [a] -> Just $ sSnoc l a-               _   -> Nothing+        case getQuery rf p k q of+            [Just a] -> Just $ sSnoc l a+            _        -> Nothing     strategyRep _ = StrategyRep "one"  -- | get parameters ( [0,) params to [Type] ) since 0.5.0.0.

@@ -16,42 +16,38 @@ module Control.Monad.Apiary.Internal where  import Network.Wai+ import Control.Applicative import Control.Monad import Control.Monad.Trans import Control.Monad.Identity import Control.Monad.Trans.Control import Control.Monad.Base+import Control.Monad.Apiary.Action.Internal+ import Data.Apiary.SList import Data.Apiary.Document import Data.Monoid import Text.Blaze.Html import qualified Data.Text as T -import Control.Monad.Apiary.Action.Internal--data ApiaryReader n c = ApiaryReader-    { readerFilter :: ActionT n (SList c)-    , readerConfig :: ApiaryConfig-    , readerDoc    :: Doc -> Doc+data ApiaryEnv n c = ApiaryEnv+    { envFilter :: ActionT n (SList c)+    , envConfig :: ApiaryConfig+    , envDoc    :: Doc -> Doc     } +initialEnv :: Monad n => ApiaryConfig -> ApiaryEnv n '[]+initialEnv conf = ApiaryEnv (return SNil) conf id+ data ApiaryWriter n = ApiaryWriter     { writerHandler :: ActionT n ()     , writerDoc     :: [Doc]     } -instance Monad n => Monoid (ApiaryWriter n) where-    mempty = ApiaryWriter mzero []-    ApiaryWriter ah ad `mappend` ApiaryWriter bh bd =-        ApiaryWriter (mplus ah bh) (ad <> bd)--initialReader :: Monad n => ApiaryConfig -> ApiaryReader n '[]-initialReader conf = ApiaryReader (return SNil) conf id- -- | most generic Apiary monad. since 0.8.0.0. newtype ApiaryT c n m a = ApiaryT { unApiaryT :: forall b.-    ApiaryReader n c+    ApiaryEnv n c     -> (a -> ApiaryWriter n -> m b)     -> m b      }@@ -59,23 +55,45 @@ -- | no transformer. (ActionT IO, ApiaryT Identity) type Apiary c = ApiaryT c IO Identity +apiaryT :: Monad m+        => (ApiaryEnv n c -> m (a, ApiaryWriter n))+        -> ApiaryT c n m a+apiaryT f = ApiaryT $ \env cont -> f env >>= \(a,w) -> cont a w++runApiaryT :: (Monad n, Monad m) => (forall b. n b -> IO b) -> ApiaryConfig+           -> ApiaryT '[] n m a -> m Application+runApiaryT run conf m = unApiaryT m (initialEnv conf) (\_ w -> return w) >>= \wtr -> do+    let doc = docsToDocuments $ writerDoc wtr+        app = execActionT conf doc $ hoistActionT run (writerHandler wtr)+    return app++runApiary :: ApiaryConfig -> Apiary '[] a -> Application+runApiary conf m = runIdentity $ runApiaryT id conf m++--------------------------------------------------------------------------------++instance Monad n => Monoid (ApiaryWriter n) where+    mempty = ApiaryWriter mzero []+    ApiaryWriter ah ad `mappend` ApiaryWriter bh bd =+        ApiaryWriter (mplus ah bh) (ad <> bd)+ instance Functor (ApiaryT c n m) where-    fmap f m = ApiaryT $ \rdr cont ->-        unApiaryT m rdr $ \a hdr -> hdr `seq` cont (f a) hdr+    fmap f m = ApiaryT $ \env cont ->+        unApiaryT m env $ \a hdr -> hdr `seq` cont (f a) hdr  instance Monad n => Applicative (ApiaryT c n m) where     pure x = ApiaryT $ \_ cont -> cont x mempty-    mf <*> ma = ApiaryT $ \rdr cont ->-        unApiaryT mf rdr $ \f hdr  ->-        unApiaryT ma rdr $ \a hdr' ->+    mf <*> ma = ApiaryT $ \env cont ->+        unApiaryT mf env $ \f hdr  ->+        unApiaryT ma env $ \a hdr' ->         let hdr'' = hdr <> hdr'         in hdr'' `seq` cont (f a) hdr''  instance Monad n => Monad (ApiaryT c n m) where     return x = ApiaryT $ \_ cont -> cont x mempty-    m >>= k = ApiaryT $ \rdr cont ->-        unApiaryT    m  rdr $ \a hdr  ->-        unApiaryT (k a) rdr $ \b hdr' -> +    m >>= k = ApiaryT $ \env cont ->+        unApiaryT    m  env $ \a hdr  ->+        unApiaryT (k a) env $ \b hdr' ->          let hdr'' = hdr <> hdr'         in hdr'' `seq` cont b hdr'' @@ -88,16 +106,11 @@ instance (Monad n, MonadBase b m) => MonadBase b (ApiaryT c n m) where     liftBase m = ApiaryT $ \_ c -> liftBase m >>= \a -> c a mempty -apiaryT :: Monad m-        => (ApiaryReader n c -> m (a, ApiaryWriter n))-        -> ApiaryT c n m a-apiaryT f = ApiaryT $ \rdr cont -> f rdr >>= \(a,w) -> cont a w- instance Monad n => MonadTransControl (ApiaryT c n) where     newtype StT (ApiaryT c n) a = StTApiary' { unStTApiary' :: (a, ApiaryWriter n) }-    liftWith f = apiaryT $ \rdr ->+    liftWith f = apiaryT $ \env ->         liftM (\a -> (a, mempty)) -        (f $ \t -> liftM StTApiary' $ unApiaryT t rdr (\a w -> return (a,w)))+        (f $ \t -> liftM StTApiary' $ unApiaryT t env (\a w -> return (a,w)))     restoreT m = apiaryT $ \_ -> liftM unStTApiary' m  instance (Monad n, MonadBaseControl b m) => MonadBaseControl b (ApiaryT c n m) where@@ -105,23 +118,13 @@     liftBaseWith = defaultLiftBaseWith StMApiary'     restoreM     = defaultRestoreM   unStMApiary' -runApiaryT' :: (Monad n, Monad m) => (forall b. n b -> IO b) -> ApiaryConfig-            -> ApiaryT '[] n m a -> m (Application, Documents)-runApiaryT' run conf m = unApiaryT m (initialReader conf) (\_ w -> return w) >>= \wtr -> do-    let doc = docsToDocuments $ writerDoc wtr-        da  = maybe mzero (\f -> f doc) $ documentationAction conf-        app = execActionT conf $ hoistActionT run (writerHandler wtr) `mplus` da-    return (app, doc)--runApiaryT :: (Monad n, Monad m) => (forall b. n b -> IO b) -> ApiaryConfig-           -> ApiaryT '[] n m a -> m Application-runApiaryT run conf m = fst `liftM` runApiaryT' run conf m+-------------------------------------------------------------------------------- -runApiary :: ApiaryConfig -> Apiary '[] a -> Application-runApiary conf m = runIdentity $ runApiaryT id conf m+getApiaryEnv :: Monad n => ApiaryT c n m (ApiaryEnv n c)+getApiaryEnv = ApiaryT $ \env cont -> cont env mempty  apiaryConfig :: Monad n => ApiaryT c n m ApiaryConfig-apiaryConfig = ApiaryT $ \r cont -> cont (readerConfig r) mempty+apiaryConfig = liftM envConfig getApiaryEnv  addRoute :: Monad n => ApiaryWriter n -> ApiaryT c n m () addRoute r = ApiaryT $ \_ cont -> cont () r@@ -129,48 +132,53 @@ -- | filter by action. since 0.6.1.0. focus :: Monad n => (Doc -> Doc) -> (SList c -> ActionT n (SList c'))       -> ApiaryT c' n m a -> ApiaryT c n m a-focus d g m = ApiaryT $ \rdr cont -> unApiaryT m rdr -    { readerFilter = readerFilter rdr >>= g -    , readerDoc    = readerDoc rdr . d+focus d g m = ApiaryT $ \env cont -> unApiaryT m env +    { envFilter = envFilter env >>= g +    , envDoc    = envDoc env . d     } cont  -- | splice ActionT ApiaryT. action :: Monad n => Fn c (ActionT n ()) -> ApiaryT c n m () action = action' . apply +-- | like action. but not apply arguments. since 0.8.0.0.+action' :: Monad n => (SList c -> ActionT n ()) -> ApiaryT c n m ()+action' a = do+    env <- getApiaryEnv+    addRoute $ ApiaryWriter (envFilter env >>= \c -> a c) +        [envDoc env Action]++--------------------------------------------------------------------------------++insDoc :: (Doc -> Doc) -> ApiaryT c n m a -> ApiaryT c n m a+insDoc d m = ApiaryT $ \env cont -> unApiaryT m env+    { envDoc = envDoc env . d } cont+ -- | API document group. since 0.12.0.0. -- -- only top level group recognized. group :: T.Text -> ApiaryT c n m a -> ApiaryT c n m a-group d m = ApiaryT $ \rdr cont -> unApiaryT m rdr-    { readerDoc = readerDoc rdr . DocGroup d } cont+group = insDoc . DocGroup  -- | add API document. since 0.12.0.0. -- -- It use only filters prior document, -- so you should be placed document directly in front of action. document :: T.Text -> ApiaryT c n m a -> ApiaryT c n m a-document d m = ApiaryT $ \rdr cont -> unApiaryT m rdr-    { readerDoc = \_ -> readerDoc rdr (Document $ Just d) } cont+document = insDoc . Document  -- | add user defined precondition. since 0.13.0. precondition :: Html -> ApiaryT c n m a -> ApiaryT c n m a-precondition d m = ApiaryT $ \rdr cont -> unApiaryT m rdr-    { readerDoc = readerDoc rdr . DocPrecondition d } cont+precondition = insDoc . DocPrecondition +noDoc :: ApiaryT c n m a -> ApiaryT c n m a+noDoc = insDoc DocDropNext++--------------------------------------------------------------------------------+ {-# DEPRECATED actionWithPreAction "use action'" #-} -- | execute action before main action. since 0.4.2.0 actionWithPreAction :: Monad n => (SList xs -> ActionT n a)                     -> Fn xs (ActionT n ()) -> ApiaryT xs n m () actionWithPreAction pa a = do     action' $ \c -> pa c >> apply a c--getReader :: Monad n => ApiaryT c n m (ApiaryReader n c)-getReader = ApiaryT $ \rdr cont -> cont rdr mempty---- | like action. but not apply arguments. since 0.8.0.0.-action' :: Monad n => (SList c -> ActionT n ()) -> ApiaryT c n m ()-action' a = do-    rdr <- getReader-    addRoute $ ApiaryWriter (readerFilter rdr >>= \c -> a c) -        [readerDoc rdr $ Document Nothing]

@@ -7,24 +7,20 @@  module Data.Apiary.Document where -import Language.Haskell.TH import Control.Applicative-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.ByteString as S+ import Data.Typeable import Data.Maybe-import Data.Apiary.Param-import qualified Network.HTTP.Types as HT-import Text.Blaze.Html-import Text.Blaze.Internal(attribute)-import qualified Text.Blaze.Html5 as H-import qualified Text.Blaze.Html5.Attributes as A-import Data.Monoid-import Data.Default.Class import Data.List import Data.Function +import Data.Apiary.Param+import Data.Apiary.Method++import Text.Blaze.Html+import qualified Data.Text as T+import qualified Data.ByteString as S+ data StrategyRep = StrategyRep     { strategyInfo :: T.Text }     deriving (Show, Eq)@@ -33,12 +29,17 @@     = DocPath   T.Text       Doc     | DocRoot                Doc     | DocFetch  TypeRep (Maybe Html) Doc-    | DocMethod HT.Method    Doc-    | DocQuery  S.ByteString StrategyRep QueryRep Html Doc-    | DocGroup  T.Text       Doc+    | DocDropNext            Doc++    | DocMethod Method       Doc+    | DocQuery  S.ByteString StrategyRep QueryRep (Maybe Html) Doc     | DocPrecondition Html   Doc-    | Document  (Maybe T.Text)+    | DocGroup  T.Text       Doc+    | Document  T.Text       Doc+    | Action +--------------------------------------------------------------------------------+ data Route     = Path  T.Text               Route     | Fetch TypeRep (Maybe Html) Route@@ -57,14 +58,14 @@  data PathDoc = PathDoc     { path    :: Route-    , methods :: [(HT.Method, [MethodDoc])]+    , methods :: [(Method, [MethodDoc])]     }  data QueryDoc = QueryDoc     { queryName     :: S.ByteString     , queryStrategy :: StrategyRep     , queryRep      :: QueryRep-    , queryDocument :: Html+    , queryDocument :: (Maybe Html)     }  data MethodDoc = MethodDoc@@ -73,22 +74,37 @@     , document      :: T.Text     } +--------------------------------------------------------------------------------+ docToDocument :: Doc -> Maybe (Maybe T.Text, PathDoc) docToDocument = \case-    (DocGroup "" d') -> (Nothing,) <$> loop id (\md -> [("*", md)]) id id d'-    (DocGroup g d')  -> (Just  g,) <$> loop id (\md -> [("*", md)]) id id d'-    d'               -> (Nothing,) <$> loop id (\md -> [("*", md)]) id id d'+    (DocGroup "" d') -> (Nothing,) <$> loop id (\md -> [("*", md)]) id id Nothing d'+    (DocGroup g  d') -> (Just  g,) <$> loop id (\md -> [("*", md)]) id id Nothing d'+    d'               -> (Nothing,) <$> loop id (\md -> [("*", md)]) id id Nothing d'   where-    loop ph mh qs pc (DocPath         t d) = loop (ph . Path t) mh qs pc d-    loop _  mh qs pc (DocRoot           d) = loop (const $ Path "" End) mh qs pc d-    loop ph mh qs pc (DocFetch      t h d) = loop (ph . Fetch t h) mh qs pc d-    loop ph _  qs pc (DocMethod       m d) = loop ph (\md -> [(m, md)]) qs pc d-    loop ph mh qs pc (DocQuery  p s q t d) = loop ph mh (qs . (QueryDoc p s q t:)) pc d-    loop ph mh qs pc (DocGroup        _ d) = loop ph mh qs pc d-    loop ph mh qs pc (DocPrecondition h d) = loop ph mh qs (pc . (h:)) d-    loop ph mh qs pc (Document   (Just t)) = Just . PathDoc (ph End) $ mh [MethodDoc (qs []) (pc []) t]-    loop _  _  _  _  (Document    Nothing) = Nothing+    loop ph mh qs ps doc     (DocDropNext       d) = loop ph mh qs ps doc (dropNext d)+    loop ph mh qs pc doc     (DocPath         t d) = loop (ph . Path t) mh qs pc doc d+    loop _  mh qs pc doc     (DocRoot           d) = loop (const $ Path "" End) mh qs pc doc d+    loop ph mh qs pc doc     (DocFetch      t h d) = loop (ph . Fetch t h) mh qs pc doc d+    loop ph _  qs pc doc     (DocMethod       m d) = loop ph (\md -> [(m, md)]) qs pc doc d+    loop ph mh qs pc doc     (DocQuery  p s q t d) = loop ph mh (qs . (QueryDoc p s q t:)) pc doc d+    loop ph mh qs pc doc     (DocPrecondition h d) = loop ph mh qs (pc . (h:)) doc d+    loop ph mh qs pc doc     (DocGroup        _ d) = loop ph mh qs pc doc d+    loop ph mh qs pc _       (Document        t d) = loop ph mh qs pc (Just t) d+    loop ph mh qs pc (Just t) Action               = Just . PathDoc (ph End) $ mh [MethodDoc (qs []) (pc []) t]+    loop _  _  _  _  Nothing  Action               = Nothing +    dropNext (DocPath         _ d) = d+    dropNext (DocRoot           d) = d+    dropNext (DocFetch      _ _ d) = d+    dropNext (DocDropNext       d) = dropNext d+    dropNext (DocMethod       _ d) = d+    dropNext (DocQuery  _ _ _ _ d) = d+    dropNext (DocPrecondition _ d) = d+    dropNext (DocGroup        _ d) = d+    dropNext (Document        _ d) = d+    dropNext Action                = Action+ mergePathDoc :: [PathDoc] -> [PathDoc] mergePathDoc [] = [] mergePathDoc (pd:pds) = merge (filter (same pd) pds) : mergePathDoc (filter (not . same pd) pds)@@ -96,7 +112,7 @@     same           = (==) `on` path     merge pds' = PathDoc (path pd) (mergeMethods $ methods pd ++ concatMap methods pds') -mergeMethods :: [(HT.Method, [MethodDoc])] -> [(HT.Method, [MethodDoc])]+mergeMethods :: [(Method, [MethodDoc])] -> [(Method, [MethodDoc])] mergeMethods [] = [] mergeMethods (m:ms) = merge (filter (same m) ms) : mergeMethods (filter (not . same m) ms)   where@@ -117,148 +133,4 @@     trav (Nothing, _) = Nothing     trav (Just a,  b) = Just (a, b) -routeToHtml :: Route -> (T.Text, Html, Html)-routeToHtml = loop (1::Int) "" mempty []-  where-    sp = H.span "/" ! A.class_ "splitter"-    loop i e r p (Path s d)          = loop i (T.concat [e, "/", s]) (r <> sp <> H.span (toHtml s) ! A.class_ "path") p d-    loop i e r p (Fetch t Nothing d) = -        loop (succ i) (T.concat [e, "/:", T.pack $ show t]) (r <> sp <> rpHtml (toHtml $ show t) i) p d-    loop i e r p (Fetch t (Just h) d) = -        loop (succ i) (T.concat [e, "/:", T.pack $ show t]) (r <> sp <> rpHtml (toHtml $ show t) i)-            (p <> [H.tr $ H.td (toHtml i) <> H.td (toHtml $ show t) <> H.td h]) d-    loop _ e r p End =-        (e, r-        , if null p-          then mempty-          else H.table ! A.class_ "table table-condensed route-parameters" $-               H.tr (mconcat -                    [ H.th ! A.class_ "col-sm-1 com-md-1" $ "#"-                    , H.th ! A.class_ "col-sm-1 com-md-1" $ "type"-                    , H.th "description"-                    ]) <> mconcat p-        ) --data DefaultDocumentConfig = DefaultDocumentConfig-    { documentTitle       :: T.Text-    , documentDescription :: Maybe Html-    , documentUseCDN      :: Bool-    }--instance Default DefaultDocumentConfig where-    def = DefaultDocumentConfig "API documentation" Nothing True--defaultDocumentToHtml :: DefaultDocumentConfig -> Documents -> Html-defaultDocumentToHtml DefaultDocumentConfig{..} docs =-    H.docTypeHtml $ H.head headH <> H.body body <> footer-  where-    css u = H.link ! A.rel "stylesheet" ! A.href u-    js  u = H.script ! A.src u $ mempty-    dataToggle = attribute "data-toggle" " data-toggle=\""-    dataTarget = attribute "data-target" " data-target=\""--    mcMap f = mconcat . map f--    cdns = mconcat-        [ css "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css"-        , js  "//code.jquery.com/jquery-2.1.1.min.js"-        , js  "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/js/bootstrap.min.js"-        ]--    embeds = $( do-        let embed f p = runIO (readFile p) >>= \c -> [|$(varE f) $ preEscapedToHtml (c :: String)|]-        [| mconcat -            [ $(embed 'H.style  "static/bootstrap.min.css")-            , $(embed 'H.script "static/jquery-2.1.1.min.js")-            , $(embed 'H.script "static/bootstrap.min.js")-            ]-         |])--    headH = mconcat -        [ H.title (toHtml documentTitle)-        , if documentUseCDN then cdns else embeds-        , $(runIO (readFile "static/jquery.cookie-1.4.1.min.js") >>= \c -> [|H.script $ preEscapedToHtml (c::String)|])-        , $(runIO (readFile "static/api-documentation.min.js")   >>= \c -> [|H.script $ preEscapedToHtml (c::String)|])-        , $(runIO (readFile "static/api-documentation.min.css")  >>= \c -> [|H.style  $ preEscapedToHtml (c::String)|])-        ]--    htmlQR (Strict   r) = toHtml (show r)-    htmlQR (Nullable r) = toHtml (show r) <> "?"-    htmlQR  Check       = "check"--    query (QueryDoc p s q t) = H.tr . mconcat $-        [ H.td (toHtml $ T.decodeUtf8 p)-        , H.td (toHtml $ strategyInfo s)-        , H.td (htmlQR q)-        , H.td t-        ]--    queriesH [] = mempty-    queriesH qs =-        H.div ! A.class_ "col-sm-offset-1 col-md-offset-1" $-        H.table ! A.class_ "table table-condensed" $ mconcat-        [ H.caption "Query parameters"-        , H.tr $ mconcat [ H.th ! A.class_ "col-sm-1 col-md-1" $ "name"-                         , H.th ! A.class_ "col-sm-1 col-md-1" $ "num"-                         , H.th ! A.class_ "col-sm-1 col-md-1" $ "type"-                         , H.th "description"-                         ]-        , mcMap query qs-        ]--    preconds [] = mempty-    preconds p =-        H.div ! A.class_ "well well-sm precondition" $ mconcat-            [ H.p "Preconditions:"-            , H.ul $ mcMap (\h -> H.li h) p-            ]--    method (m, ms) = H.div ! A.class_ "method" $ mconcat-        [ H.h4 . toHtml $ T.decodeUtf8 m-        , mcMap action ms-        ]--    action (MethodDoc qs pc d) = H.div ! A.class_ "action col-sm-offset-1 col-md-offset-1" $ mconcat-        [ preconds pc-        , H.div $ H.p (toHtml d)-        , queriesH qs-        ]--    pathH grp (PathDoc r ms) =-        let (idnt, route, rdoc) = routeToHtml r-        in H.div ! A.class_ "panel panel-default" $ mconcat-            [ H.div ! A.class_ "panel-heading clearfix"-                ! dataToggle "collapse" ! dataTarget (toValue $ T.concat ["[id='collapse-", grp, "-", idnt, "']"]) $ mconcat-                [ H.h3 ! A.class_ "panel-title pull-left" $ route-                , H.div ! A.class_ "methods" $-                    mcMap ((\m -> H.div ! A.class_ "pull-right" $ toHtml (T.decodeUtf8 m)) . fst) (reverse ms)-                ]-            , H.div ! A.id (toValue $ T.concat ["collapse-", grp, "-", idnt]) ! A.class_ "panel-collapse collapse" $-                rdoc <> (H.div ! A.class_ "panel-body" $ mcMap method ms)-            ]--    groupH (g, p) =-        let gs = mcMap (pathH g) p-        in H.div ! A.id (toValue $ T.append "group-" g) $ mconcat [H.h2 $ toHtml g, gs]--    doc (Documents n g) =-        let ng = mcMap (pathH "") n-            gs = mcMap groupH g-        in (H.div ! A.id "no-group") ng <> gs--    body  = H.div ! A.class_ "container" $ mconcat-        [ H.div ! A.class_ "page-header" $ H.h1 (toHtml documentTitle)-        , maybe mempty (H.div ! A.class_ "description") documentDescription-        , doc docs-        ]--    footer = H.footer $ mconcat-        [ "This API documentation generated by "-        , H.a ! A.href "https://github.com/philopon/apiary" $ "apiary"-        , " web framework."-        ]---- | construct Html as route parameter. since 0.13.0.-rpHtml :: Html -> Int -> Html-rpHtml s i = H.span (":" <> s <> H.sup (toHtml i)) ! A.class_ "fetch"

@@ -0,0 +1,169 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Apiary.Document.Html where++import Language.Haskell.TH++import Data.Monoid+import Data.Default.Class++import Data.Apiary.Param+import Data.Apiary.Method+import Data.Apiary.Document++import Text.Blaze.Html+import Text.Blaze.Internal(attribute)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+++routeToHtml :: Route -> (T.Text, Html, Html)+routeToHtml = loop (1::Int) "" mempty []+  where+    sp = H.span "/" ! A.class_ "splitter"+    loop i e r p (Path s d)          = loop i (T.concat [e, "/", s]) (r <> sp <> H.span (toHtml s) ! A.class_ "path") p d+    loop i e r p (Fetch t Nothing d) = +        loop (succ i) (T.concat [e, "/:", T.pack $ show t]) (r <> sp <> rpHtml (toHtml $ show t) i) p d+    loop i e r p (Fetch t (Just h) d) = +        loop (succ i) (T.concat [e, "/:", T.pack $ show t]) (r <> sp <> rpHtml (toHtml $ show t) i)+            (p <> [H.tr $ H.td (toHtml i) <> H.td (toHtml $ show t) <> H.td h]) d+    loop _ e r p End =+        (e, r+        , if null p+          then mempty+          else H.table ! A.class_ "table table-condensed route-parameters" $+               H.tr (mconcat +                    [ H.th ! A.class_ "col-sm-1 com-md-1" $ "#"+                    , H.th ! A.class_ "col-sm-1 com-md-1" $ "type"+                    , H.th "description"+                    ]) <> mconcat p+        )++data DefaultDocumentConfig = DefaultDocumentConfig+    { documentTitle       :: T.Text+    , documentDescription :: Maybe Html+    , documentUseCDN      :: Bool+    }++instance Default DefaultDocumentConfig where+    def = DefaultDocumentConfig "API documentation" Nothing True++defaultDocumentToHtml :: DefaultDocumentConfig -> Documents -> Html+defaultDocumentToHtml DefaultDocumentConfig{..} docs =+    H.docTypeHtml $ H.head headH <> H.body body <> footer+  where+    css u = H.link ! A.rel "stylesheet" ! A.href u+    js  u = H.script ! A.src u $ mempty+    dataToggle = attribute "data-toggle" " data-toggle=\""+    dataTarget = attribute "data-target" " data-target=\""++    mcMap f = mconcat . map f++    cdns = mconcat+        [ css "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css"+        , js  "//code.jquery.com/jquery-2.1.1.min.js"+        , js  "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/js/bootstrap.min.js"+        ]++    embeds = $( do+        let embed f p = runIO (readFile p) >>= \c -> [|$(varE f) $ preEscapedToHtml (c :: String)|]+        [| mconcat +            [ $(embed 'H.style  "static/bootstrap.min.css")+            , $(embed 'H.script "static/jquery-2.1.1.min.js")+            , $(embed 'H.script "static/bootstrap.min.js")+            ]+         |])++    headH = mconcat +        [ H.title (toHtml documentTitle)+        , if documentUseCDN then cdns else embeds+        , $(runIO (readFile "static/jquery.cookie-1.4.1.min.js") >>= \c -> [|H.script $ preEscapedToHtml (c::String)|])+        , $(runIO (readFile "static/api-documentation.min.js")   >>= \c -> [|H.script $ preEscapedToHtml (c::String)|])+        , $(runIO (readFile "static/api-documentation.min.css")  >>= \c -> [|H.style  $ preEscapedToHtml (c::String)|])+        ]++    htmlQR (Strict   r) = toHtml (show r)+    htmlQR (Nullable r) = H.span (toHtml (show r) <> "?") ! A.title (toValue (show r) <> "(nullable)")+    htmlQR  Check       = "check"++    noDesc = H.span "no description" ! A.class_ "no-description"++    query (QueryDoc p s q t) = H.tr . mconcat $+        [ H.td (toHtml $ T.decodeUtf8 p)+        , H.td (toHtml $ strategyInfo s)+        , H.td (htmlQR q)+        , H.td $ maybe noDesc id t+        ]++    queriesH [] = mempty+    queriesH qs =+        H.div ! A.class_ "col-sm-offset-1 col-md-offset-1" $+        H.table ! A.class_ "table table-condensed" $ mconcat+        [ H.caption "Query parameters"+        , H.tr $ mconcat [ H.th ! A.class_ "col-sm-1 col-md-1" $ "name"+                         , H.th ! A.class_ "col-sm-1 col-md-1" $ "num"+                         , H.th ! A.class_ "col-sm-1 col-md-1" $ "type"+                         , H.th "description"+                         ]+        , mcMap query qs+        ]++    preconds [] = mempty+    preconds p =+        H.div ! A.class_ "well well-sm precondition" $ mconcat+            [ H.p "Preconditions:"+            , H.ul $ mcMap (\h -> H.li h) p+            ]++    method (m, ms) = H.div ! A.class_ "method" $ mconcat+        [ H.h4 . toHtml $ T.decodeUtf8 $ renderMethod m+        , mcMap action ms+        ]++    action (MethodDoc qs pc d) = H.div ! A.class_ "action col-sm-offset-1 col-md-offset-1" $ mconcat+        [ preconds pc+        , H.div $ H.p (toHtml d)+        , queriesH qs+        ]++    pathH grp (PathDoc r ms) =+        let (idnt, route, rdoc) = routeToHtml r+        in H.div ! A.class_ "panel panel-default" $ mconcat+            [ H.div ! A.class_ "panel-heading clearfix"+                ! dataToggle "collapse" ! dataTarget (toValue $ T.concat ["[id='collapse-", grp, "-", idnt, "']"]) $ mconcat+                [ H.h3 ! A.class_ "panel-title pull-left" $ route+                , H.div ! A.class_ "methods" $+                    mcMap ((\m -> H.div ! A.class_ "pull-right" $ toHtml (T.decodeUtf8 m)) . renderMethod . fst) (reverse ms)+                ]+            , H.div ! A.id (toValue $ T.concat ["collapse-", grp, "-", idnt]) ! A.class_ "panel-collapse collapse" $+                rdoc <> (H.div ! A.class_ "panel-body" $ mcMap method ms)+            ]++    groupH (g, p) =+        let gs = mcMap (pathH g) p+        in H.div ! A.id (toValue $ T.append "group-" g) $ mconcat [H.h2 $ toHtml g, gs]++    doc (Documents n g) =+        let ng = mcMap (pathH "") n+            gs = mcMap groupH g+        in (H.div ! A.id "no-group") ng <> gs++    body  = H.div ! A.class_ "container" $ mconcat+        [ H.div ! A.class_ "page-header" $ H.h1 (toHtml documentTitle)+        , maybe mempty (H.div ! A.class_ "description") documentDescription+        , doc docs+        ]++    footer = H.footer $ mconcat+        [ "This API documentation generated by "+        , H.a ! A.href "https://github.com/philopon/apiary" $ "apiary"+        , " web framework."+        ]++-- | construct Html as route parameter. since 0.13.0.+rpHtml :: Html -> Int -> Html+rpHtml s i = H.span (":" <> s <> H.sup (toHtml i)) ! A.class_ "fetch"

@@ -0,0 +1,39 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Apiary.Method where++import Data.String+import qualified Data.ByteString.Char8 as S++data Method+    = GET+    | POST+    | HEAD+    | PUT+    | DELETE+    | TRACE+    | CONNECT+    | OPTIONS+    | PATCH+    | NonStandard S.ByteString+    deriving (Eq, Ord, Read, Show)++renderMethod :: Method -> S.ByteString+renderMethod = \case+    GET           -> "GET"+    POST          -> "POST"+    HEAD          -> "HEAD"+    PUT           -> "PUT"+    DELETE        -> "DELETE"+    TRACE         -> "TRACE"+    CONNECT       -> "CONNECT"+    OPTIONS       -> "OPTIONS"+    PATCH         -> "PATCH"+    NonStandard a -> a+{-# INLINE renderMethod #-}++instance IsString Method where+    fromString = NonStandard . S.pack++

@@ -16,30 +16,23 @@  module Data.Apiary.Param where -import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL-import qualified Data.ByteString.Char8 as S-import qualified Data.ByteString.Lazy.Char8 as L+import Network.Wai+ import Data.Int import Data.Word import Data.Proxy+import Data.Apiary.Proxy+ import Data.String(IsString)-import Data.Text.Encoding.Error import Text.Read-import Network.Wai+import Data.Text.Encoding.Error+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL -#if __GLASGOW_HASKELL__ > 707-import qualified Data.Typeable-import Data.Typeable hiding (typeRep)-typeRep   = Data.Typeable.typeRep-#else-import Data.Typeable-typeRep _ = typeOf (undefined :: a)-#endif-typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep-{-# INLINE typeRep #-}+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L  jsToBool :: (IsString a, Eq a) => a -> Bool jsToBool = flip notElem jsFalse@@ -107,7 +100,9 @@ class Typeable a => Query a where     readQuery :: Maybe S.ByteString -> Maybe a     queryRep  :: proxy a            -> QueryRep-    queryRep = Strict . typeRep+    queryRep = Strict . qTypeRep+    qTypeRep  :: proxy a            -> TypeRep+    qTypeRep = typeRep  -- | javascript boolean. -- when \"false\", \"0\", \"-0\", \"\", \"null\", \"undefined\", \"NaN\" then False, else True. since 0.6.0.0.@@ -131,34 +126,35 @@  instance Query T.Text  where     readQuery  = fmap $ T.decodeUtf8With lenientDecode-    queryRep _ = Strict (typeRep (Proxy :: Proxy Text))+    qTypeRep _ = typeRep (Proxy :: Proxy Text)  instance Query TL.Text where     readQuery  = fmap (TL.decodeUtf8With lenientDecode . L.fromStrict)-    queryRep _ = Strict (typeRep (Proxy :: Proxy Text))+    qTypeRep _ = typeRep (Proxy :: Proxy Text)  instance Query S.ByteString where      readQuery  = id-    queryRep _ = Strict (typeRep (Proxy :: Proxy Text))+    qTypeRep _ = typeRep (Proxy :: Proxy Text)  instance Query L.ByteString where      readQuery  = fmap L.fromStrict-    queryRep _ = Strict (typeRep (Proxy :: Proxy Text))+    qTypeRep _ = typeRep (Proxy :: Proxy Text)  instance Query String       where     readQuery  = fmap S.unpack-    queryRep _ = Strict (typeRep (Proxy :: Proxy Text))+    qTypeRep _ = typeRep (Proxy :: Proxy Text)  -- | allow no parameter. but check parameter type. instance Query a => Query (Maybe a) where     readQuery (Just a) = Just `fmap` readQuery (Just a)     readQuery Nothing  = Just Nothing-    queryRep  _        = Nullable $ typeRep (Proxy :: Proxy a)+    queryRep _         = Nullable $ qTypeRep (Proxy :: Proxy a) --- | always success. for exists check.+-- | always success. for check existence. instance Query () where     readQuery _ = Just ()-    queryRep _ = Check+    queryRep  _ = Check+    qTypeRep  _ = typeOf ()  pBool :: Proxy Bool pBool = Proxy

@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Apiary.Proxy+    ( module Export+#if __GLASGOW_HASKELL__ < 707+    , typeRep+#endif+    ) where++#if __GLASGOW_HASKELL__ > 707+import Data.Typeable as Export+#else+import Data.Proxy    as Export+import Data.Typeable as Export+typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep+typeRep _ = typeOf (undefined :: a)+{-# INLINE typeRep #-}+#endif

@@ -5,17 +5,28 @@     , module Data.Apiary.Param     , act     -- * reexports+    , module Data.Default.Class+    , module Network.HTTP.Types.Status     -- | MonadIO     , module Control.Monad.Trans     -- | MonadPlus(..), msum, mfilter, guard     , module Control.Monad+    -- | Strategy Proxies+    , module Control.Monad.Apiary.Filter.Internal.Strategy+    -- | FilePart(..)+    , module Network.Wai     ) where+ +import Web.Apiary.TH+import Network.Wai(FilePart(..))+import Network.HTTP.Types.Status hiding (mkStatus)  import Control.Monad.Apiary import Control.Monad.Apiary.Action-import Data.Apiary.Param-+import Control.Monad.Apiary.Filter+import Control.Monad.Apiary.Filter.Internal.Strategy (pFirst, pOne, pOption, pCheck, pMany, pSome) import Control.Monad.Trans(MonadIO(..)) import Control.Monad (MonadPlus(..), msum, mfilter, guard)-import Control.Monad.Apiary.Filter-import Web.Apiary.TH++import Data.Default.Class+import Data.Apiary.Param

@@ -2,14 +2,18 @@ {-# LANGUAGE TemplateHaskell #-} module Web.Apiary.TH where -import Control.Monad.Apiary-import Control.Monad.Apiary.Action import Language.Haskell.TH import Language.Haskell.TH.Quote++import Network.HTTP.Types.Status+import Network.Mime++import Control.Monad.Apiary+import Control.Monad.Apiary.Action+ import qualified Data.Text as T import qualified Data.ByteString.Char8 as S import Data.Apiary.SList-import Network.Mime  numToCode :: Int -> ExpQ numToCode = \case

@@ -1,1 +1,1 @@-.fetch{color:gray}footer{padding-top:30px;padding-bottom:50px;margin-top:20px;text-align:center;color:#777;border-top:1px solid #e5e5e5}.description{margin-bottom:20px}table{margin-top:15px !important;margin-bottom:0 !important}table.route-parameters{margin-top:0 !important;border-bottom:1px solid #ddd;background-color:#f5f5f5}.method{margin-bottom:20px;padding-bottom:10px;border-bottom:1px solid #ddd}.method:last-child{margin-bottom:0;padding-bottom:0;border-bottom:0}.methods div{margin-left:10px;color:#999}.panel-heading,h1{cursor:pointer}.precondition{margin-bottom:10px}.action{margin-bottom:20px}.action:last-child{margin-bottom:0}+.fetch{color:gray}footer{padding-top:30px;padding-bottom:50px;margin-top:20px;text-align:center;color:#777;border-top:1px solid #e5e5e5}.description{margin-bottom:20px}table{margin-top:15px !important;margin-bottom:0 !important}table.route-parameters{margin-top:0 !important;border-bottom:1px solid #ddd;background-color:#f5f5f5}.method{margin-bottom:20px;padding-bottom:10px;border-bottom:1px solid #ddd}.method:last-child{margin-bottom:0;padding-bottom:0;border-bottom:0}.methods div{margin-left:10px;color:#999}.panel-heading,h1{cursor:pointer}.precondition{margin-bottom:10px}.action{margin-bottom:20px}.action:last-child{margin-bottom:0}.no-description{color:#aaa}

@@ -66,8 +66,8 @@  methodFilterApp :: Application methodFilterApp = runApiary def $ do-    method   "GET" . action $ contentType "text/plain" >> lbs "GET"-    stdMethod POST . action $ contentType "text/plain" >> lbs "POST"+    method "GET" . action $ contentType "text/plain" >> lbs "GET"+    method POST  . action $ contentType "text/plain" >> lbs "POST"  methodFilterTest :: Test methodFilterTest = testGroup "methodFilter"@@ -112,7 +112,7 @@ captureApp :: Application captureApp = runApiary def $ do     [capture|/foo|]  . action $ contentType "text/plain" >> lbs "foo"-    [capture|/:Int|] . stdMethod GET . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Int", L.pack $ show i])+    [capture|/:Int|] . method GET . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Int", L.pack $ show i])     [capture|/:Double|] . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Double", L.pack $ show i])     [capture|/bar/:L.ByteString/:Int|] . action $ \s i -> contentType "text/plain" >> lbs (L.unwords [s, L.pack $ show i])     [capture|/:L.ByteString|] . action $ \s -> contentType "text/plain" >> lbs (L.unwords ["fall", s])@@ -150,7 +150,7 @@     , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app     , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app     , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int 12" app-    , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String \"12\"" app+    , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo Int 12" app     ]   where app = queryApp (=:) (=:) (=:) @@ -230,10 +230,10 @@ multipleFilter1App :: Application multipleFilter1App = runApiary def $ do     root $ do-        stdMethod GET  . action $ contentType "text/plain" >> lbs "GET /"-        stdMethod POST . action $ contentType "text/html"  >> lbs "POST /"+        method GET  . action $ contentType "text/plain" >> lbs "GET /"+        method POST . action $ contentType "text/html"  >> lbs "POST /" -    stdMethod DELETE . action $ contentType "text/plain" >> lbs "DELETE ANY"+    method DELETE . action $ contentType "text/plain" >> lbs "DELETE ANY"  multipleFilter1Test :: Test multipleFilter1Test = testGroup "multiple test1: root, method"