apiary 0.6.1.0 → 0.7.0.0

raw patch · 8 files changed

+211/−195 lines, 8 filesdep −monad-loggerPVP ok

version bump matches the API change (PVP)

Dependencies removed: monad-logger

API changes (from Hackage documentation)

Files

• apiary.cabal +3/−4
• src/Control/Monad/Apiary.hs +1/−3
• src/Control/Monad/Apiary/Action.hs +6/−3
• src/Control/Monad/Apiary/Action/Internal.hs +114/−105
• src/Control/Monad/Apiary/Filter.hs +28/−36
• src/Control/Monad/Apiary/Filter/Internal.hs +3/−3
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +1/−1
• src/Control/Monad/Apiary/Internal.hs +55/−40

@@ -1,5 +1,5 @@ name:                apiary-version:             0.6.1.0+version:             0.7.0.0 synopsis:            Simple web framework inspired by scotty. description:   Simple web framework inspired by scotty.@@ -31,11 +31,11 @@   404 Page Notfound.   @   .-    * Nestable route handling(ApiaryT Monad; capture, stdMethod and more.).+    * Nestable route handling(Apiary Monad; capture, stdMethod and more.).   .     * type safe route filter.   .-  full example & tutorial: <https://github.com/philopon/apiary/blob/master/examples/main.lhs>+  more examples: <https://github.com/philopon/apiary/blob/master/examples/>  license:             MIT license-file:        LICENSE@@ -86,7 +86,6 @@                      , bytestring         >=0.10 && <0.11                      , blaze-builder      >=0.3 && <0.4                      , conduit            >=1.1 && <1.2-                     , monad-logger       >=0.3 && <0.4                      , data-default-class >=0.0 && <0.1                      , tagged             >=0.7 && <0.8                      , reflection         >=1.4 && <1.5

@@ -1,8 +1,6 @@ module Control.Monad.Apiary-    ( ApiaryT-    , Apiary+    ( Apiary     , runApiary-    , runApiaryT     -- * getter     , apiaryConfig     -- * execute action

@@ -1,6 +1,6 @@ module Control.Monad.Apiary.Action      (-      ActionT+      Action     , ApiaryConfig(..)     -- * actions     , stop, stopWith@@ -23,10 +23,13 @@      -- ** monolithic action     -- *** redirect-    , redirect-    , redirectPermanently, redirectFound, redirectSeeOther, redirectTemporary+    , redirect, redirectPermanently, redirectTemporary+    , redirectWith     -- * Reexport     , module Data.Default.Class+    +    -- * deprecated+    , redirectFound, redirectSeeOther     ) where  import Control.Monad.Apiary.Action.Internal

@@ -13,7 +13,6 @@ import Control.Monad import Control.Monad.Trans import Control.Monad.Base-import Control.Monad.Reader import Control.Monad.Trans.Control import Network.Wai import Network.Mime@@ -25,7 +24,6 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import Data.Conduit-import qualified Control.Monad.Logger as Logger  data ApiaryConfig = ApiaryConfig     { -- | call when no handler matched.@@ -72,198 +70,209 @@     st = actionStatus  as     hd = actionHeaders as -data Action a +data Act a      = Continue a     | Pass     | Stop Response -newtype ActionT m a = ActionT { unActionT :: forall b. +newtype Action a = Action { unAction :: forall b.      ApiaryConfig     -> Request     -> ActionState-    -> (a -> ActionState -> m (Action b))-    -> m (Action b)+    -> (a -> ActionState -> IO (Act b))+    -> IO (Act 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 Functor Action where+    fmap f m = Action $ \conf req st cont ->+        unAction 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'' ->+instance Applicative Action where+    pure x = Action $ \_ _ st cont -> cont x st+    mf <*> ma = Action $ \conf req st cont ->+        unAction mf conf req st  $ \f st'  ->+        unAction 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 _ = ActionT $ \_ _ _ _ -> return Pass+instance Monad Action where+    return x = Action $ \_ _ st cont -> cont x st+    m >>= k  = Action $ \conf req st cont ->+        unAction m conf req st $ \a st' ->+        st' `seq` unAction (k a) conf req st' cont+    fail _ = Action $ \_ _ _ _ -> return Pass -instance MonadIO m => MonadIO (ActionT m) where-    liftIO m = ActionT $ \_ _ st cont ->+instance MonadIO Action where+    liftIO m = Action $ \_ _ st cont ->         liftIO m >>= \a -> cont a st -instance MonadTrans ActionT where-    lift m = ActionT $ \_ _ st cont ->-        m >>= \a -> cont a st--runActionT :: Monad m => ActionT m a+runAction :: Action a            -> ApiaryConfig -> Request -> ActionState-           -> m (Action (a, ActionState))-runActionT m conf req st = unActionT m conf req st $ \a st' ->+           -> IO (Act (a, ActionState))+runAction m conf req st = unAction m conf req st $ \a st' ->     st' `seq` return (Continue (a, st')) -actionT :: Monad m -        => (ApiaryConfig -> Request -> ActionState -> m (Action (a, ActionState)))-        -> ActionT m a-actionT f = ActionT $ \conf req st cont -> f conf req st >>= \case+action :: (ApiaryConfig -> Request -> ActionState -> IO (Act (a, ActionState)))+        -> Action a+action f = Action $ \conf req st cont -> f conf req st >>= \case     Pass             -> return Pass     Stop s           -> return $ Stop s     Continue (a,st') -> st' `seq` cont a st' -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-execActionT config m request = runActionT m config request resp >>= \case+execAction :: ApiaryConfig -> Action () -> Application+execAction config m request = runAction m config request resp >>= \case         Pass           -> notFound config request         Stop s         -> return s         Continue (_,r) -> return $ actionStateToResponse r   where     resp = ActionState (defaultStatus config) (defaultHeader config) (LBS "") -instance (Monad m, Functor m) => Alternative (ActionT m) where+instance Alternative Action where     empty = mzero     (<|>) = mplus -instance Monad m => MonadPlus (ActionT m) where-    mzero = actionT $ \_ _ _ -> return Pass-    mplus m n = actionT $ \c r s -> runActionT m c r s >>= \case+instance MonadPlus Action where+    mzero = action $ \_ _ _ -> return Pass+    mplus m n = action $ \c r s -> runAction m c r s >>= \case         Continue a -> return $ Continue a         Stop stp   -> return $ Stop stp-        Pass       -> runActionT n c r s+        Pass       -> runAction n c r s -instance Monad m => Monoid (ActionT m ()) where+instance Monoid (Action ()) where     mempty  = mzero     mappend = 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--instance MonadBaseControl b m => MonadBaseControl b (ActionT m) where-    newtype StM (ActionT m) a = StMT { unStMT :: ComposeSt ActionT m a }-    liftBaseWith = defaultLiftBaseWith StMT-    restoreM     = defaultRestoreM unStMT--instance MonadReader r m => MonadReader r (ActionT m) where-    ask     = lift ask-    local f = hoistActionT $ local f+instance MonadBase IO Action where+    liftBase = liftIO -instance Logger.MonadLogger m => Logger.MonadLogger (ActionT m) where-    monadLoggerLog loc src lv msg = lift $ Logger.monadLoggerLog loc src lv msg+instance MonadBaseControl IO Action where+    newtype StM Action a = StMAction { unStMAction :: Act (a, ActionState) }+    liftBaseWith f = action $ \c r s ->+        liftM (\a -> Continue (a, s)) (f $ \t -> liftM StMAction $ runAction t c r s)+    restoreM m = action $ \_ _ _ -> return (unStMAction m)  -- | stop handler and send current state. since 0.3.3.0.-stop :: Monad m => ActionT m a-stop = ActionT $ \_ _ s _ -> return $ Stop (actionStateToResponse s)+stop :: Action a+stop = Action $ \_ _ s _ -> return $ Stop (actionStateToResponse s)  -- | stop with response. since 0.4.2.0.-stopWith :: Monad m => Response -> ActionT m a-stopWith a = ActionT $ \_ _ _ _ -> return $ Stop a+stopWith :: Response -> Action a+stopWith a = Action $ \_ _ _ _ -> return $ Stop a  -- | get raw request. since 0.1.0.0.-getRequest :: Monad m => ActionT m Request-getRequest = ActionT $ \_ r s c -> c r s+getRequest :: Action Request+getRequest = Action $ \_ r s c -> c r s -getConfig :: Monad m => ActionT m ApiaryConfig-getConfig = ActionT $ \c _ s cont -> cont c s+getConfig :: Action ApiaryConfig+getConfig = Action $ \c _ s cont -> cont c s -modifyState :: Monad m => (ActionState -> ActionState) -> ActionT m ()-modifyState f = ActionT $ \_ _ s c -> c () (f s)+modifyState :: (ActionState -> ActionState) -> Action ()+modifyState f = Action $ \_ _ s c -> c () (f s)  -- | get all request headers. since 0.6.0.0.-getHeaders :: Monad m => ActionT m RequestHeaders+getHeaders :: Action RequestHeaders getHeaders = requestHeaders `liftM` getRequest  -- | set status code. since 0.1.0.0.-status :: Monad m => Status -> ActionT m ()+status :: Status -> Action () status st = modifyState (\s -> s { actionStatus = st } )  -- | modify response header. since 0.1.0.0.-modifyHeader :: Monad m => (ResponseHeaders -> ResponseHeaders) -> ActionT m ()+modifyHeader :: (ResponseHeaders -> ResponseHeaders) -> Action () modifyHeader f = modifyState (\s -> s {actionHeaders = f $ actionHeaders s } )  -- | add response header. since 0.1.0.0.-addHeader :: Monad m => HeaderName -> S.ByteString -> ActionT m ()+addHeader :: HeaderName -> S.ByteString -> Action () addHeader h v = modifyHeader ((h,v):)  -- | set response headers. since 0.1.0.0.-setHeaders :: Monad m => ResponseHeaders -> ActionT m ()+setHeaders :: ResponseHeaders -> Action () setHeaders hs = modifyHeader (const hs)  -- | set content-type header. -- if content-type header already exists, replace it. since 0.1.0.0.-contentType :: Monad m => S.ByteString -> ActionT m ()+contentType :: S.ByteString -> Action () contentType c = modifyHeader     (\h -> ("Content-Type", c) : filter (("Content-Type" /=) . fst) h)  -- | redirect handler ----- set status, location header and stop. since 0.3.3.0.-redirect :: Monad m-         => Status-         -> S.ByteString -- ^ Location redirect to-         -> ActionT m a-redirect st url = do+-- set status, add location header. since 0.3.3.0.+--+-- rename from redirect in 0.6.2.0.+redirectWith :: Status+             -> S.ByteString -- ^ Location redirect to+             -> Action ()+redirectWith st url = do     status st-    setHeaders [("location", url)]-    stop+    addHeader "location" url --- | redirect with 301 Moved Permanently. since 0.3.3.0.-redirectPermanently :: Monad m => S.ByteString -> ActionT m a-redirectPermanently = redirect movedPermanently301+--      HTTP/1.0            HTTP/1.1+-- 300                      MultipleChoices+-- 301  MovedPermanently    MovedPermanently+-- 302  MovedTemporarily    Found+-- 303                      SeeOther+-- 304  NotModified         NotModified+-- 305                      UseProxy+-- 307                      TemporaryRedirect --- | redirect with 302 Found. since 0.3.3.0.-redirectFound       :: Monad m => S.ByteString -> ActionT m a-redirectFound       = redirect found302+-- | redirect with 301 Moved Permanently. since 0.3.3.0.+redirectPermanently :: S.ByteString -> Action ()+redirectPermanently = redirectWith movedPermanently301 --- | redirect with 303 See Other. since 0.3.3.0.-redirectSeeOther    :: Monad m => S.ByteString -> ActionT m a-redirectSeeOther    = redirect seeOther303+-- | redirect with:+--+-- 303 See Other (HTTP/1.1)  or+-- 302 Moved Temporarily (Other)+-- +-- since 0.6.2.0.+redirect :: S.ByteString -> Action ()+redirect to = do+    v <- httpVersion <$> getRequest+    if v == http11+        then redirectWith seeOther303 to+        else redirectWith status302   to --- | redirect with 307 Temporary Redirect. since 0.3.3.0.-redirectTemporary   :: Monad m => S.ByteString -> ActionT m a-redirectTemporary   = redirect temporaryRedirect307+-- | redirect with:+--+-- 307 Temporary Redirect (HTTP/1.1) or+-- 302 Moved Temporarily (Other)+--+-- since 0.3.3.0.+redirectTemporary :: S.ByteString -> Action ()+redirectTemporary to = do+    v <- httpVersion <$> getRequest+    if v == http11+        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 :: FilePath -> Maybe FilePart -> Action () file f p = do     mime <- mimeType <$> getConfig     contentType (mime f)     file' f p  -- | set response body file content, without set Content-Type. since 0.1.0.0.-file' :: Monad m => FilePath -> Maybe FilePart -> ActionT m ()+file' :: FilePath -> Maybe FilePart -> Action () file' f p = modifyState (\s -> s { actionBody = File f p } )  -- | set response body builder. since 0.1.0.0.-builder :: Monad m => Builder -> ActionT m ()+builder :: Builder -> Action () builder b = modifyState (\s -> s { actionBody = Builder b } )  -- | set response body lazy bytestring. since 0.1.0.0.-lbs :: Monad m => L.ByteString -> ActionT m ()+lbs :: L.ByteString -> Action () lbs l = modifyState (\s -> s { actionBody = LBS l } )  -- | set response body source. since 0.1.0.0.-source :: Monad m => Source IO (Flush Builder) -> ActionT m ()+source :: Source IO (Flush Builder) -> Action () source src = modifyState (\s -> s { actionBody = SRC src } )++{-# DEPRECATED redirectFound, redirectSeeOther "use redirect" #-}+-- | redirect with 302 Found. since 0.3.3.0.+redirectFound       :: S.ByteString -> Action ()+redirectFound       = redirectWith found302++-- | redirect with 303 See Other. since 0.3.3.0.+redirectSeeOther    :: S.ByteString -> Action ()+redirectSeeOther    = redirectWith seeOther303

@@ -60,35 +60,35 @@ import Control.Monad.Apiary.Internal  -- | filter by HTTP method. since 0.1.0.0.-method :: Monad m => HT.Method -> ApiaryT c m a -> ApiaryT c m a+method :: HT.Method -> Apiary c a -> Apiary c a method m = function_ ((m ==) . requestMethod)  -- | filter by HTTP method using StdMethod. since 0.1.0.0.-stdMethod :: Monad m => StdMethod -> ApiaryT c m a -> ApiaryT c m a+stdMethod :: StdMethod -> Apiary c a -> Apiary c a stdMethod = method . HT.renderStdMethod  -- | filter by ssl accessed. since 0.1.0.0.-ssl :: Monad m => ApiaryT c m a -> ApiaryT c m a+ssl :: Apiary c a -> Apiary c a ssl = function_ isSecure  -- | http version filter. since 0.5.0.0.-httpVersion :: Monad m => HT.HttpVersion  -> ApiaryT c m b -> ApiaryT c m b+httpVersion :: HT.HttpVersion  -> Apiary c b -> Apiary c b httpVersion v = function_ $ (v ==) . Wai.httpVersion  -- | http/0.9 only accepted fiter. since 0.5.0.0.-http09 :: Monad m => ApiaryT c m b -> ApiaryT c m b+http09 :: Apiary c b -> Apiary c b http09 = Control.Monad.Apiary.Filter.httpVersion HT.http09  -- | http/1.0 only accepted fiter. since 0.5.0.0.-http10 :: Monad m => ApiaryT c m b -> ApiaryT c m b+http10 :: Apiary c b -> Apiary c b http10 = Control.Monad.Apiary.Filter.httpVersion HT.http10  -- | http/1.1 only accepted fiter. since 0.5.0.0.-http11 :: Monad m => ApiaryT c m b -> ApiaryT c m b+http11 :: Apiary c b -> Apiary c b http11 = Control.Monad.Apiary.Filter.httpVersion HT.http11  -- | filter by 'Control.Monad.Apiary.Action.rootPattern' of 'Control.Monad.Apiary.Action.ApiaryConfig'.-root :: Monad m => ApiaryT c m b -> ApiaryT c m b+root :: Apiary c b -> Apiary c b root m = do     rs <- rootPattern `liftM` apiaryConfig     function_ (\r -> rawPathInfo r `elem` rs) m@@ -107,11 +107,11 @@ -- query "key" (Proxy :: Proxy ('Many' String) -- get all \'key\' query parameter as String. -- @ -- -query :: (Query a, Strategy.Strategy w, Monad m)+query :: (Query a, Strategy.Strategy w)       => S.ByteString       -> Proxy (w a)-      -> ApiaryT (Strategy.SNext w as a) m b-      -> ApiaryT as m b+      -> Apiary (Strategy.SNext w as a) b+      -> Apiary as b query k p = function $ \l r -> Strategy.readStrategy readQuery ((k ==) . fst) p (queryString r) l  -- | get first matched paramerer. since 0.5.0.0.@@ -119,8 +119,7 @@ -- @ -- "key" =: pInt == query "key" (pFirst pInt) == query "key" (Proxy :: Proxy (First Int)) -- @-(=:) :: (Query a, Monad m)-     => S.ByteString -> Proxy a -> ApiaryT (Snoc as a) m b -> ApiaryT as m b+(=:) :: Query a => S.ByteString -> Proxy a -> Apiary (Snoc as a) b -> Apiary as b k =: t = query k (pFirst t)  -- | get one matched paramerer. since 0.5.0.0.@@ -130,8 +129,7 @@ -- @ -- "key" =: pInt == query "key" (pOne pInt) == query "key" (Proxy :: Proxy (One Int)) -- @-(=!:) :: (Query a, Monad m)-      => S.ByteString -> Proxy a -> ApiaryT (Snoc as a) m b -> ApiaryT as m b+(=!:) :: Query a => S.ByteString -> Proxy a -> Apiary (Snoc as a) b -> Apiary as b k =!: t = query k (pOne t)  -- | get optional first paramerer. since 0.5.0.0.@@ -141,8 +139,7 @@ -- @ -- "key" =: pInt == query "key" (pOption pInt) == query "key" (Proxy :: Proxy (Option Int)) -- @-(=?:) :: (Query a, Monad m)-      => S.ByteString -> Proxy a -> ApiaryT (Snoc as (Maybe a)) m b -> ApiaryT as m b+(=?:) :: Query a => S.ByteString -> Proxy a -> Apiary (Snoc as (Maybe a)) b -> Apiary as b k =?: t = query k (pOption t)  -- | check parameger given and type. since 0.5.0.0.@@ -152,8 +149,7 @@ -- @ -- "key" =: pInt == query "key" (pCheck pInt) == query "key" (Proxy :: Proxy (Check Int)) -- @-(?:) :: (Query a, Monad m)-     => S.ByteString -> Proxy a -> ApiaryT as m b -> ApiaryT as m b+(?:) :: Query a => S.ByteString -> Proxy a -> Apiary as b -> Apiary as b k ?: t = query k (pCheck t)  -- | get many paramerer. since 0.5.0.0.@@ -161,8 +157,7 @@ -- @ -- "key" =: pInt == query "key" (pMany pInt) == query "key" (Proxy :: Proxy (Many Int)) -- @-(=*:) :: (Query a, Monad m)-      => S.ByteString -> Proxy a -> ApiaryT (Snoc as [a]) m b -> ApiaryT as m b+(=*:) :: Query a => S.ByteString -> Proxy a -> Apiary (Snoc as [a]) b -> Apiary as b k =*: t = query k (pMany t)  -- | get some paramerer. since 0.5.0.0.@@ -170,8 +165,7 @@ -- @ -- "key" =: pInt == query "key" (pSome pInt) == query "key" (Proxy :: Proxy (Some Int)) -- @-(=+:) :: (Query a, Monad m)-      => S.ByteString -> Proxy a -> ApiaryT (Snoc as [a]) m b -> ApiaryT as m b+(=+:) :: Query a => S.ByteString -> Proxy a -> Apiary (Snoc as [a]) b -> Apiary as b k =+: t = query k (pSome t)  -- | query exists checker.@@ -180,42 +174,40 @@ -- hasQuery q = 'query' q (Proxy :: Proxy ('Check' ())) -- @ ---hasQuery :: Monad m => S.ByteString -> ApiaryT c m a -> ApiaryT c m a+hasQuery :: S.ByteString -> Apiary c a -> Apiary c a hasQuery q = query q (Proxy :: Proxy (Strategy.Check ()))  --------------------------------------------------------------------------------  -- | check whether to exists specified header or not. since 0.6.0.0.-hasHeader :: Monad m => HT.HeaderName-          -> ApiaryT as m b -> ApiaryT as m b+hasHeader :: HT.HeaderName -> Apiary as b -> Apiary as b hasHeader n = header' pCheck ((n ==) . fst)  -- | check whether to exists specified valued header or not. since 0.6.0.0.-eqHeader :: Monad m => HT.HeaderName +eqHeader :: HT.HeaderName           -> S.ByteString  -- ^ header value-         -> ApiaryT as m b-         -> ApiaryT as m b+         -> Apiary as b+         -> Apiary as b eqHeader k v = header' pCheck (\(k',v') -> k == k' && v == v')  -- | filter by header and get first. since 0.6.0.0.-header :: Monad m => HT.HeaderName-       -> ApiaryT (Snoc as S.ByteString) m b -> ApiaryT as m b+header :: HT.HeaderName+       -> Apiary (Snoc as S.ByteString) b -> Apiary as b header n = header' pFirst ((n ==) . fst)  -- | filter by headers up to 100 entries. since 0.6.0.0.-headers :: Monad m => HT.HeaderName-        -> ApiaryT (Snoc as [S.ByteString]) m b -> ApiaryT as m b+headers :: HT.HeaderName -> Apiary (Snoc as [S.ByteString]) b -> Apiary as b headers n = header' limit100 ((n ==) . fst)   where     limit100 :: Proxy x -> Proxy (Strategy.LimitSome $(int 100) x)     limit100 _ = Proxy  -- | low level header filter. since 0.6.0.0.-header' :: (Strategy.Strategy w, Monad m)+header' :: (Strategy.Strategy w)         => (forall x. Proxy x -> Proxy (w x))         -> (HT.Header -> Bool)-        -> ApiaryT (Strategy.SNext w as S.ByteString) m b-        -> ApiaryT as m b+        -> Apiary (Strategy.SNext w as S.ByteString) b+        -> Apiary as b header' pf kf = function $ \l r ->     Strategy.readStrategy Just kf (pf pByteString) (requestHeaders r) l 

@@ -9,15 +9,15 @@ import Data.Apiary.SList  -- | low level filter function.-function :: Monad m => (SList c -> Request -> Maybe (SList c')) -> ApiaryT c' m b -> ApiaryT c m b+function :: (SList c -> Request -> Maybe (SList c')) -> Apiary c' b -> Apiary c b function f = focus $ \c -> getRequest >>= \r -> case f c r of     Nothing -> mzero     Just c' -> return c'  -- | filter and append argument.-function' :: Monad m => (Request -> Maybe a) -> ApiaryT (Snoc as a) m b -> ApiaryT as m b+function' :: (Request -> Maybe a) -> Apiary (Snoc as a) b -> Apiary as b function' f = function $ \c r -> sSnoc c `fmap` f r  -- | filter only(not modify arguments).-function_ :: Monad m => (Request -> Bool) -> ApiaryT c m b -> ApiaryT c m b+function_ :: (Request -> Bool) -> Apiary c b -> Apiary c b function_ f = function $ \c r -> if f r then Just c else Nothing

@@ -60,5 +60,5 @@ -- capture myCapture . stdMethod GET . action $ \age name -> do --     yourAction -- @-capture :: (Capture as, Monad m) => SList as -> ApiaryT (CaptureResult xs as) m b -> ApiaryT xs m b+capture :: Capture as => SList as -> Apiary (CaptureResult xs as) b -> Apiary xs b capture cap = function $ \bf req -> capture' cap (pathInfo req) bf

@@ -2,6 +2,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}  {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-}@@ -13,73 +16,85 @@  import Network.Wai import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.Control+import Control.Monad.Base import Data.Monoid import Data.Apiary.SList  import Control.Monad.Apiary.Action.Internal -newtype ApiaryT c m a = ApiaryT { unApiaryT :: forall b.-    (forall x . m x -> IO x)-    -> ActionT IO (SList c)+newtype Apiary c a = Apiary { unApiary :: forall b.+    Action (SList c)     -> ApiaryConfig-    -> (a -> ActionT IO () -> m b)-    -> m b +    -> (a -> Action () -> IO b)+    -> IO b      } -instance Functor (ApiaryT c m) where-    fmap f m = ApiaryT $ \run grd conf cont ->-        unApiaryT m run grd conf $ \a hdr -> hdr `seq` cont (f a) hdr+instance Functor (Apiary c) where+    fmap f m = Apiary $ \grd conf cont ->+        unApiary m grd conf $ \a hdr -> hdr `seq` cont (f a) hdr -instance Applicative (ApiaryT c m) where-    pure x = ApiaryT $ \_ _ _ cont -> cont x mempty-    mf <*> ma = ApiaryT $ \run grd conf cont ->-        unApiaryT mf run grd conf $ \f hdr  ->-        unApiaryT ma run grd conf $ \a hdr' ->+instance Applicative (Apiary c) where+    pure x = Apiary $ \_ _ cont -> cont x mempty+    mf <*> ma = Apiary $ \grd conf cont ->+        unApiary mf grd conf $ \f hdr  ->+        unApiary ma grd conf $ \a hdr' ->         let hdr'' = hdr <> hdr'         in hdr'' `seq` cont (f a) hdr'' -instance Monad (ApiaryT c m) where-    return x = ApiaryT $ \_ _ _ cont -> cont x mempty-    m >>= k = ApiaryT $ \run grd conf cont ->-        unApiaryT m run grd conf $ \a hdr ->-        unApiaryT (k a) run grd conf $ \b hdr' -> +instance Monad (Apiary c) where+    return x = Apiary $ \_ _ cont -> cont x mempty+    m >>= k = Apiary $ \grd conf cont ->+        unApiary    m  grd conf $ \a hdr  ->+        unApiary (k a) grd conf $ \b hdr' ->          let hdr'' = hdr <> hdr'         in hdr'' `seq` cont b hdr'' -runApiaryT :: Monad m => ApiaryConfig -> (forall x. m x -> IO x) -> ApiaryT '[] m a -> Application-runApiaryT conf run m req = run (unApiaryT m run (return SNil) conf (\_ w -> return w)) >>= \a ->-    execActionT conf a req+instance MonadIO (Apiary c) where+    liftIO m = Apiary $ \_ _ c -> m >>= \a -> c a mempty -type Apiary c = ApiaryT c IO+instance MonadBase IO (Apiary c) where+    liftBase = liftIO -runApiary :: ApiaryConfig -> Apiary '[] a -> Application-runApiary conf = runApiaryT conf id+apiary :: (Action (SList c) -> ApiaryConfig -> IO (a,Action ())) -> Apiary c a+apiary f = Apiary $ \grd conf cont -> f grd conf >>= \(a,w) -> cont a w -getRunner :: Monad m => ApiaryT c m (ActionT m a -> ActionT IO a)-getRunner = ApiaryT $ \run _ _ c -> c (hoistActionT run) mempty+run :: Apiary c a -> Action (SList c) -> ApiaryConfig -> IO (a, Action ())+run m grd conf = unApiary m grd conf $ \a w -> return (a,w) -getGuard :: ApiaryT c m (ActionT IO (SList c))-getGuard = ApiaryT $ \_ grd _ c -> c grd mempty+instance MonadBaseControl IO (Apiary c) where+    newtype StM (Apiary c) a = StMApiary { unStMApiary :: (a, Action ()) }+    liftBaseWith f = apiary $ \g c ->+        liftM (\a -> (a, mempty)) (f $ \t -> liftM StMApiary $ run t g c)+    restoreM m = apiary $ \_ _ -> return (unStMApiary m) -apiaryConfig :: ApiaryT c m ApiaryConfig-apiaryConfig = ApiaryT $ \_ _ c cont -> cont c mempty+runApiary :: ApiaryConfig -> Apiary '[] a -> Application+runApiary conf m req = unApiary m (return SNil) conf (\_ w -> return w) >>= \a ->+    execAction conf a req -addRoute :: ActionT IO () -> ApiaryT c m ()-addRoute r = ApiaryT $ \_ _ _ cont -> cont () r+getGuard :: Apiary c (Action (SList c))+getGuard = Apiary $ \grd _ c -> c grd mempty +apiaryConfig :: Apiary c ApiaryConfig+apiaryConfig = Apiary $ \_ c cont -> cont c mempty++addRoute :: Action () -> Apiary c ()+addRoute r = Apiary $ \_ _ cont -> cont () r+ -- | filter by action. since 0.6.1.0.-focus :: (SList c -> ActionT IO (SList c')) -> ApiaryT c' m a -> ApiaryT c m a+focus :: (SList c -> Action (SList c')) -> Apiary c' a -> Apiary c a focus g m = do-    ApiaryT $ \run grd cfg cont ->-        unApiaryT m run (grd >>= g) cfg cont+    Apiary $ \grd cfg cont ->+        unApiary m (grd >>= g) cfg cont -action :: Monad m => Fn c (ActionT m ()) -> ApiaryT c m ()+action :: Fn c (Action ()) -> Apiary c () action = actionWithPreAction (const $ return ())  -- | execute action before main action. since v0.4.2.0-actionWithPreAction :: Monad m => (SList xs -> ActionT IO a)-                    -> Fn xs (ActionT m ()) -> ApiaryT xs m ()+actionWithPreAction :: (SList xs -> Action a)+                    -> Fn xs (Action ()) -> Apiary xs () actionWithPreAction pa a = do-    tr  <- getRunner     grd <- getGuard-    addRoute $ grd >>= \c -> (pa c) >> tr (apply a c)+    addRoute $ grd >>= \c -> (pa c) >> apply a c