apiary 0.16.0 → 0.17.0

raw patch · 15 files changed

+297/−73 lines, 15 filesdep +processdep ~textdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependency ranges changed: text, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• apiary.cabal +10/−6
• src/Control/Monad/Apiary.hs +2/−3
• src/Control/Monad/Apiary/Filter.hs +15/−4
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +5/−0
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +3/−2
• src/Control/Monad/Apiary/Internal.hs +34/−23
• src/Data/Apiary/Document/Html.hs +18/−4
• src/Data/Apiary/Extension.hs +33/−13
• src/Data/Apiary/Extension/Internal.hs +11/−2
• src/Data/Apiary/Param.hs +1/−0
• src/Web/Apiary.hs +4/−4
• src/Web/Apiary/Heroku.hs +110/−0
• src/Web/Apiary/TH.hs +1/−0
• test/Application.hs +33/−12

@@ -1,3 +1,20 @@+# 0.17.0+* fix not accept in multi Accept header.+* add greedy path capture('\*\*').+* add switchQuery filter.+* add Heroku module.+* add google analytics support to API documentation.++## Extension API+* change interface.+* fix bug which immediately finalize.+* deprecate preAction.+* Category initializer only ghc-7.8+.++## new extensions+* apiary-mongoDB+* apiary-memcached+ # 0.16.0 * new Extension API. * add middleware function.

@@ -1,5 +1,5 @@ name:                apiary-version:             0.16.0+version:             0.17.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.@@ -31,15 +31,17 @@   404 Page Notfound.   @   .-    * High performance(benchmark: <https://github.com/philopon/apiary-benchmark/tree/v0.16.0>).+    * High performance(benchmark: <https://github.com/philopon/apiary-benchmark/tree/v0.17.0>).   .     * 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.16.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v0.16.0/examples/api.html>).+    * Auto generate API documentation(example: <https://github.com/philopon/apiary/blob/v0.17.0/examples/api.hs>, <https://rawgit.com/philopon/apiary/v0.17.0/examples/api.html>).   .-  more examples: <https://github.com/philopon/apiary/blob/v0.16.0/examples/>+  more examples: <https://github.com/philopon/apiary/blob/v0.17.0/examples/>+  .+  live demo: <http://best-haskell.herokuapp.com/> (source code: <https://github.com/philopon/best-haskell>)  license:             MIT license-file:        LICENSE@@ -66,6 +68,7 @@  library   exposed-modules:     Web.Apiary+                       Web.Apiary.Heroku                        Web.Apiary.Wai                         Control.Monad.Apiary@@ -100,7 +103,7 @@                      , http-types           >=0.8   && <0.9                      , mime-types           >=0.1   && <0.2 -                     , text                 >=1.1   && <1.2+                     , text                 >=1.1   && <1.3                      , bytestring           >=0.10  && <0.11                      , bytestring-lexing    >=0.4   && <0.5                      , blaze-builder        >=0.3   && <0.4@@ -111,7 +114,8 @@                      , data-default-class   >=0.0   && <0.1                      , unordered-containers >=0.2   && <0.3                      , hashable             >=1.1   && <1.3-                     , time                 >=1.4   && <1.5+                     , time                 >=1.4   && <1.6+                     , process              >=1.2   && <1.3    if impl(ghc < 7.8)     build-depends:     tagged               >=0.7   && <0.8

@@ -1,7 +1,6 @@ module Control.Monad.Apiary-    ( ApiaryT, server-    , runApiaryTWith-    , runApiaryWith+    ( ApiaryT, EApplication, server, serverWith+    , runApiaryT     , runApiary     -- * getter     , apiaryConfig

@@ -18,7 +18,6 @@     , http09, http10, http11     -- ** path matcher     , root-    , anyPath     , capture     , Capture.path     , Capture.endPath@@ -30,6 +29,7 @@     -- *** specified operators     , (=:), (=!:), (=?:), (=?!:), (?:), (=*:), (=+:)     , hasQuery+    , switchQuery      -- ** header matcher     , hasHeader@@ -44,7 +44,7 @@          -- * deprecated     , stdMethod-+    , anyPath     ) where  import Network.Wai as Wai@@ -68,7 +68,9 @@ import qualified Data.Text.Encoding as T import Data.Monoid import Data.Proxy+import Data.Apiary.SList import Data.String+import Data.Maybe  import Data.Apiary.Param import Data.Apiary.Document@@ -112,9 +114,10 @@ root :: (Monad m, Monad actM) => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m () root = focus' DocRoot Nothing (RootPath:) return +{-# DEPRECATED anyPath "use greedy filter [capture|/**|] or use restPath." #-} -- | match all subsequent path. since 0.15.0. anyPath :: (Monad m, Monad actM) => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()-anyPath = focus' id Nothing (AnyPath:) return+anyPath = focus' id Nothing (RestPath:) return  -------------------------------------------------------------------------------- @@ -239,6 +242,14 @@ hasQuery :: MonadIO actM => QueryKey -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m () hasQuery q = query q (Strategy.Check :: Strategy.Check ()) +-- | get existance of key only query parameter. since v0.17.0.+switchQuery :: Monad actM => QueryKey -> ApiaryT exts (Bool ': prms) actM m () -> ApiaryT exts prms actM m ()+switchQuery QueryKey{..} = focus doc $ \l -> do+    r <- getRequest+    return $ (not . null $ filter (\(k,v) -> isNothing v && queryKey == k) (queryString r)) ::: l+  where+    doc = DocQuery queryKey (StrategyRep "Switch") NoValue queryDesc+ --------------------------------------------------------------------------------  -- | check whether to exists specified header or not. since 0.6.0.0.@@ -284,6 +295,6 @@ accept ect = focus (DocPrecondition $ "Accept: " <> toHtml (T.decodeUtf8 ect)) $ \c ->     (lookup "Accept" . requestHeaders <$> getRequest) >>= \case         Nothing -> mzero-        Just ct -> if ect == fst (parseContentType ct)+        Just ac -> if parseContentType ect `elem` map (parseContentType . SC.dropWhile (== ' ')) (SC.split ',' ac)                    then contentType ect >> return c                    else mzero

@@ -41,3 +41,8 @@     f:fs -> case readPathAs p f of         Just r  -> (r ::: l) <$ modifyState (\s -> s {actionFetches = fs})         Nothing -> mzero++restPath :: (Monad m, Monad actM) => ApiaryT exts ([T.Text] ': prms) actM m () -> ApiaryT exts prms actM m ()+restPath = focus' id Nothing (RestPath:) $ \l -> liftM actionFetches getState >>= \case+    [] -> return $ [] ::: l+    fs -> fs ::: l <$ modifyState (\s -> s {actionFetches = []})

@@ -50,8 +50,8 @@             S h  -> [|Just $(stringE h)|]             N n  -> [|Just $(varE n)|]     [|Capture.fetch (Proxy :: Proxy $(conT ty)) $d . $(mkCap as)|]-mkCap (eq:as) = do-    [|(Capture.path (fromString $(stringE eq))) . $(mkCap as) |]+mkCap ("**":as) = [|Capture.restPath . $(mkCap as) |]+mkCap (eq:as)   = [|(Capture.path (fromString $(stringE eq))) . $(mkCap as) |]  -- | capture QuasiQuoter. since 0.1.0.0. --@@ -61,6 +61,7 @@ -- [capture|\/path|] -- first path == "path" -- [capture|\/int\/:Int|] -- first path == "int" && get 2nd path as Int. -- [capture|\/:Int\/:Double|] -- get first path as Int and get 2nd path as Double.+-- [capture|/**|] -- feed greedy and get all path as [Text] (since 0.17.0).  -- @ -- capture :: QuasiQuoter

@@ -40,7 +40,7 @@ data Router exts actM = Router     { children   :: H.HashMap T.Text (Router exts actM)     , capturing  :: Maybe (Router exts actM)-    , anyMatch   :: Maybe (PathMethod exts actM)+    , restMatch  :: Maybe (PathMethod exts actM)     , pathMethod :: PathMethod exts actM     } @@ -69,7 +69,7 @@         FetchPath -> Router cln (Just $ loop ps (maybe emptyRouter id cap)) anp pm         Exact p   -> Router (adjust' (loop ps) p cln) cap anp pm         EndPath   -> loop ps rtr-        AnyPath   -> Router cln cap (Just . insPathMethod $ maybe emptyPathMethod id anp) pm+        RestPath  -> Router cln cap (Just . insPathMethod $ maybe emptyPathMethod id anp) pm         RootPath  -> let cln' = foldl' (flip $ adjust' (loop [EndPath])) cln rootPat                      in loop [EndPath] $ Router cln' cap anp pm @@ -83,7 +83,7 @@               | FetchPath               | RootPath               | EndPath-              | AnyPath+              | RestPath  data ApiaryEnv exts prms actM = ApiaryEnv     { envFilter :: ActionT exts actM (SList prms)@@ -94,8 +94,8 @@     , envExts   :: Extensions exts     } -initialEnv :: Monad actM => Extensions exts -> ApiaryConfig -> ApiaryEnv exts '[] actM-initialEnv exts conf = ApiaryEnv (return SNil) Nothing id conf id exts+initialEnv :: Monad actM => ApiaryConfig -> Extensions exts -> ApiaryEnv exts '[] actM+initialEnv conf = ApiaryEnv (return SNil) Nothing id conf id  data ApiaryWriter exts actM = ApiaryWriter     { writerRouter :: Router exts actM -> Router exts actM@@ -114,10 +114,11 @@     -> (a -> ApiaryWriter exts actM -> m b)     -> m b      }+ apiaryT :: Monad m         => (ApiaryEnv exts prms actM -> m (a, ApiaryWriter exts actM))         -> ApiaryT exts prms actM m a-apiaryT f = ApiaryT $ \rdr cont -> f rdr >>= \(a,w) -> cont a w+apiaryT f = ApiaryT $ \rdr cont -> f rdr >>= \(a, w) -> cont a w  routerToAction :: Monad actM => Router exts actM -> ActionT exts actM () routerToAction router = getRequest >>= go@@ -138,30 +139,40 @@             Nothing -> cld ana             Just cp -> cld $ loop (fch . (p:)) cp ps `mplus` ana           where-            ana = maybe mzero (pmAction mzero) anp+            ana = do+                modifyState (\s -> s {actionFetches = fch $ p:ps} ) +                maybe mzero (pmAction mzero) anp             cld nxt = case H.lookup p c of                 Nothing -> nxt                 Just cd -> loop fch cd ps `mplus` nxt -runApiaryTWith :: (Monad actM, Monad m) => Initializer '[] m exts-               -> ApiaryConfig -> (forall b. actM b -> IO b) -> ApiaryT exts '[] actM m () -> m Application-runApiaryTWith (Initializer ir) conf run m = do-    exts <- ir NoExtension-    wtr  <- unApiaryT m (initialEnv exts conf) (\_ w -> return w)+type EApplication e m = Extensions e -> m Application++runApiaryT :: (Monad actM, Monad m)+           => (forall b. actM b -> IO b)+           -> ApiaryConfig+           -> ApiaryT exts '[] actM m ()+           -> EApplication exts m+runApiaryT runAct conf m exts = do+    wtr <- unApiaryT m (initialEnv conf exts) (\_ w -> return w)     let doc = docsToDocuments $ writerDoc wtr []         rtr = writerRouter wtr emptyRouter         mw  = writerMw wtr-    return $! mw $ execActionT conf exts doc (hoistActionT run $ routerToAction rtr)+    return $! mw $ execActionT conf exts doc (hoistActionT runAct $ routerToAction rtr) -runApiaryWith :: Monad m => Initializer '[] m exts-              -> ApiaryConfig -> ApiaryT exts '[] IO m () -> m Application-runApiaryWith ef conf m = runApiaryTWith ef conf id m+runApiary :: Monad m+          => ApiaryConfig+          -> ApiaryT exts '[] IO m ()+          -> EApplication exts m+runApiary = runApiaryT id -runApiary :: Monad m => ApiaryConfig -> ApiaryT '[] '[] IO m () -> m Application-runApiary = runApiaryWith noExtension+server :: Monad m => (Application -> m a) -> EApplication '[] m -> m a+server = serverWith noExtension -server :: Monad m => (Application -> m a) -> m Application -> m a-server = (=<<)+serverWith :: Monad m => Initializer m '[] exts +           -> (Application -> m a) -> (EApplication exts m) -> m a+serverWith (Initializer ir) run em = ir NoExtension $ \exts ->+    em exts >>= run  -------------------------------------------------------------------------------- @@ -211,11 +222,11 @@ getApiaryEnv :: Monad actM => ApiaryT exts prms actM m (ApiaryEnv exts prms actM) getApiaryEnv = ApiaryT $ \env cont -> cont env mempty +apiaryExt :: (Has e exts, Monad actM) => proxy e -> ApiaryT exts prms actM m e+apiaryExt p = getExtension p . envExts <$> getApiaryEnv+ apiaryConfig :: Monad actM => ApiaryT exts prms actM m ApiaryConfig apiaryConfig = liftM envConfig getApiaryEnv--apiaryExt :: (Has e exts, Monad actM) => proxy e -> ApiaryT exts prms actM m e-apiaryExt p = liftM (getExtension p . envExts) getApiaryEnv  addRoute :: Monad actM => ApiaryWriter exts actM -> ApiaryT exts prms actM m () addRoute r = ApiaryT $ \_ cont -> cont () r

@@ -44,13 +44,25 @@         )  data DefaultDocumentConfig = DefaultDocumentConfig-    { documentTitle       :: T.Text-    , documentDescription :: Maybe Html-    , documentUseCDN      :: Bool+    { documentTitle           :: T.Text+    , documentDescription     :: Maybe Html+    , documentUseCDN          :: Bool+    , documentGoogleAnalytics :: Maybe T.Text -- ^ google analytics. since 0.17.0.     } +analytics :: T.Text -> Html+analytics code = H.script . H.preEscapedToHtml . T.concat $+    [ "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){"+    , "(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),"+    , "m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)"+    , "})(window,document,'script','//www.google-analytics.com/analytics.js','ga');"+    , "ga('create', '", code, "', 'auto');"+    , "ga('send', 'pageview');"+    ]++ instance Default DefaultDocumentConfig where-    def = DefaultDocumentConfig "API documentation" Nothing True+    def = DefaultDocumentConfig "API documentation" Nothing True Nothing  defaultDocumentToHtml :: DefaultDocumentConfig -> Documents -> Html defaultDocumentToHtml DefaultDocumentConfig{..} docs =@@ -84,11 +96,13 @@         , $(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)|])+        , maybe mempty analytics documentGoogleAnalytics         ]      htmlQR (Strict   r) = toHtml (show r)     htmlQR (Nullable r) = H.span (toHtml (show r) <> "?") ! A.title (toValue (show r) <> "(nullable)")     htmlQR  Check       = "check"+    htmlQR  NoValue     = "-"      noDesc = H.span "no description" ! A.class_ "no-description" 

@@ -7,28 +7,48 @@     ( Has(getExtension)     , Extensions     , addExtension-    , Initializer, Initializer'-    , initializer, preAction, (+>)     , noExtension+    -- * create initializer+    , Initializer,  initializer+    , Initializer', initializer'+    , initializerBracket+    , initializerBracket'++    -- * combine initializer+    , (+>)+    -- * deprecated+    , preAction     ) where  import Data.Apiary.Extension.Internal -type Initializer' m a = forall i. Initializer i m (a ': i)+type Initializer' m a = forall i. Initializer m i (a ': i)  addExtension :: e -> Extensions es -> Extensions (e ': es) addExtension = AddExtension -initializer :: Monad m => m e -> Initializer' m e-initializer m = Initializer $ \e -> do-    a <- m-    return (addExtension a e)+initializer :: Monad m => (Extensions es -> m e) -> Initializer m es (e ': es)+initializer m = Initializer $ \es n -> do+    e <- m es+    n (addExtension e es) -preAction :: Monad m => m a -> Initializer i m i-preAction f = Initializer $ \e -> f >> return e+initializer' :: Monad m => m e -> Initializer' m e+initializer' m = initializer (const m) -(+>) :: Monad m => Initializer i m x -> Initializer x m o -> Initializer i m o-Initializer a +> Initializer b = Initializer $ \e -> a e >>= b+initializerBracket :: (forall a. Extensions es -> (e -> m a) -> m a) -> Initializer m es (e ': es)+initializerBracket b = Initializer $ \es n ->+    b es $ \e -> n (addExtension e es) -noExtension :: Monad m => Initializer '[] m '[]-noExtension = Initializer $ return+initializerBracket' :: (forall a. (e -> m a) -> m a) -> Initializer m es (e ': es)+initializerBracket' m = initializerBracket (const m)++{-# DEPRECATED preAction "DEPRECATED" #-}+preAction :: Monad m => m a -> Initializer m i i+preAction f = Initializer $ \es n -> f >> n es++-- | combine two Initializer. since 0.16.0.+(+>) :: Monad m => Initializer m i x -> Initializer m x o -> Initializer m i o+Initializer a +> Initializer b = Initializer $ \e m -> a e (\e' -> b e' m)++noExtension :: Monad m => Initializer m i i+noExtension = Initializer $ \es n -> n es

@@ -5,11 +5,12 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE CPP #-}  module Data.Apiary.Extension.Internal where -newtype Initializer i m o = Initializer -    {unInitializer :: Extensions i -> m (Extensions o)}+import Control.Category  data Extensions (es :: [*]) where     NoExtension  :: Extensions '[]@@ -24,3 +25,11 @@ instance Has a as => Has a (a' ': as) where     getExtension p (AddExtension _ as) = getExtension p as +newtype Initializer m i o = Initializer +    {unInitializer :: forall a. Extensions i -> (Extensions o -> m a) -> m a}++#if __GLASGOW_HASKELL__ >= 708+instance Monad m => Category (Initializer m) where+    id = Initializer $ \es m -> m es+    Initializer a . Initializer b = Initializer $ \e m -> b e (\e' -> a e' m)+#endif

@@ -64,6 +64,7 @@     = Strict   TypeRep     | Nullable TypeRep     | Check+    | NoValue     deriving (Show, Eq)  class Path a where

@@ -7,7 +7,7 @@     , module Control.Monad.Apiary.Filter.Internal.Strategy     -- | Method(..)     , module Data.Apiary.Method-    -- | (+>)+    -- | Has, Extensions, Initializer, Initializer', (+>)     , module Data.Apiary.Extension     , act @@ -19,14 +19,14 @@     , module Control.Monad.IO.Class     -- | MonadPlus(..), msum, mfilter, guard, (>=>)     , module Control.Monad-    -- | FilePart(..)+    -- | FilePart(..), Application     , module Network.Wai     -- | Html     , module Text.Blaze.Html     ) where   import Web.Apiary.TH-import Network.Wai(FilePart(..))+import Network.Wai(FilePart(..), Application) import Network.HTTP.Types.Status hiding (mkStatus)  import Control.Monad.Apiary@@ -38,6 +38,6 @@  import Data.Default.Class(def) import Data.Apiary.Param-import Data.Apiary.Extension((+>))+import Data.Apiary.Extension(Has, Extensions, Initializer, Initializer', (+>)) import Data.Apiary.Method(Method(..)) import Text.Blaze.Html(Html)

@@ -0,0 +1,110 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}++module Web.Apiary.Heroku+    ( Heroku, HerokuConfig(..)+    , heroku, herokuWith+    , getHerokuEnv, getHerokuEnv'+    ) where++import System.Environment+import System.Process+import System.Exit++import Control.Exception+import Control.Arrow hiding (app)+import Control.Applicative+import Control.Monad.Trans++import Data.IORef+import Data.Proxy+import Data.Default.Class+import qualified Data.HashMap.Strict as H+import qualified Data.Text    as T+import qualified Data.Text.IO as T++import Network.Wai+import Control.Monad.Apiary+import Data.Apiary.Extension+import Data.Apiary.Extension.Internal++data Heroku = Heroku +    { herokuEnv    :: IORef (Maybe (H.HashMap T.Text T.Text))+    , herokuConfig :: HerokuConfig+    }++data HerokuConfig = HerokuConfig+    { defaultPort          :: Int+    , herokuExecutableName :: String+    , herokuAppName        :: Maybe String+    }++instance Default HerokuConfig where+    def = HerokuConfig 3000 "heroku" Nothing++initHeroku :: MonadIO m => HerokuConfig -> Initializer' m Heroku+initHeroku conf = initializer' . liftIO $+    Heroku <$> newIORef Nothing <*> pure conf++-- | use this function instead of serverWith in heroku app. since 0.17.0.+--+-- @ serverWith exts (run 3000) . runApiary def $ foo @+--+-- to+--+-- @ herokuWith exts run def . runApiary def $ foo @+--+herokuWith :: MonadIO m => Initializer m '[Heroku] exts+           -> (Int -> Application -> m a)+           -> HerokuConfig -> EApplication exts m -> m a+herokuWith ir run conf eapp = ir' NoExtension $ \exts -> do+    port <- liftIO $ fmap read (getEnv "PORT")+        `catch` (\(_::IOError) -> return $ defaultPort conf)+    app  <- eapp exts+    run port app+  where+    Initializer ir' = initHeroku conf +> ir++-- | use this function instead of server in heroku app. since 0.17.0.+--+-- @ server (run 3000) . runApiary def $ foo @+--+-- to+--+-- @ heroku run def . runApiary def $ foo @+--+-- this function provide:+--+-- * set port by PORT environment variable.+-- * getHerokuEnv function(get config from environment variable or @ heroku config @ command).+heroku :: MonadIO m => (Int -> Application -> m a)+       -> HerokuConfig -> EApplication '[Heroku] m -> m a+heroku = herokuWith noExtension++getHerokuEnv' :: T.Text -> Heroku -> IO (Maybe T.Text)+getHerokuEnv' key Heroku{..} = try (getEnv $ T.unpack key) >>= \case+    Right e                 -> return (Just $ T.pack e)+    Left (_::SomeException) -> readIORef herokuEnv >>= \case+        Just hm -> return $ H.lookup key hm+        Nothing -> do+            let args = ["config", "-s"] +++                    maybe [] (\n -> ["--app", n]) (herokuAppName herokuConfig)+                cp   = proc (herokuExecutableName herokuConfig) args+            (_, Just hout, _, h) <- createProcess cp {std_out = CreatePipe}+            xc <- waitForProcess h+            if xc == ExitSuccess+            then do+                hm <- H.fromList . map (second T.tail . T.break  (== '=')) . T.lines+                    <$> T.hGetContents hout+                writeIORef herokuEnv (Just hm)+                return $ H.lookup key hm+            else Nothing <$ writeIORef herokuEnv (Just H.empty)+++getHerokuEnv :: Has Heroku exts => T.Text -> Extensions exts -> IO (Maybe T.Text)+getHerokuEnv key exts = getHerokuEnv' key (getExtension Proxy exts)

@@ -65,6 +65,7 @@      n   -> fail $ "unknown HTTP status code:" ++ show n +{-# DEPRECATED act "no longer maintained" #-} -- | shortcut action. since 0.6.0.0. -- -- @

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE DataKinds #-}  module Application where @@ -50,9 +51,12 @@ assert404 = assertRequest 404 (Just "text/plain") "404 Page Notfound.\n"  --------------------------------------------------------------------------------+runApp :: ApiaryT '[] '[] IO Identity () -> Application+runApp = runIdentity . server return . runApiary def+--------------------------------------------------------------------------------  helloWorldApp :: Application-helloWorldApp = runIdentity . runApiary def $ action $ do+helloWorldApp = runApp $ action $ do     contentType "text/plain"     bytes "hello" @@ -66,7 +70,7 @@ --------------------------------------------------------------------------------  methodFilterApp :: Application-methodFilterApp = runIdentity . runApiary def $ do+methodFilterApp = runApp $ do     method "GET" . action $ contentType "text/plain" >> bytes "GET"     method POST  . action $ contentType "text/plain" >> bytes "POST" @@ -81,7 +85,7 @@ --------------------------------------------------------------------------------  httpVersionApp :: Application-httpVersionApp = runIdentity . runApiary def $ do+httpVersionApp = runApp $ do     http09 . action $ contentType "text/plain" >> bytes "09"     http10 . action $ contentType "text/plain" >> bytes "10"     http11 . action $ contentType "text/plain" >> bytes "11"@@ -96,7 +100,7 @@ --------------------------------------------------------------------------------  rootFilterApp :: Application-rootFilterApp = runIdentity . runApiary def .  root . action $ do+rootFilterApp = runApp . root . action $ do     contentType "text/html"     bytes "root" @@ -110,7 +114,7 @@  -------------------------------------------------------------------------------- anyFilterApp :: Application-anyFilterApp = runIdentity . runApiary def $ [capture|/test|] . anyPath . action $ do+anyFilterApp = runApp $ [capture|/test|] . anyPath . action $ do     contentType "text/plain"     bytes "hello" @@ -123,8 +127,24 @@  -------------------------------------------------------------------------------- +restFilterApp :: Application+restFilterApp = runApp $ do+    [capture|/test/**|]   . action $ \l -> contentType "text/plain" >> showing l+    [capture|/test/neko|] . action $ contentType "text/plain" >> bytes "nyan"++restFilterTest :: Test+restFilterTest = testGroup "rest capture" $ map ($ restFilterApp)+    [ testReq "GET /" . assert404+    , testReq "GET /test" . assertPlain200 "[]"+    , testReq "GET /test/foo" . assertPlain200 "[\"foo\"]"+    , testReq "GET /test/foo/bar" . assertPlain200 "[\"foo\",\"bar\"]"+    , testReq "GET /test/neko" . assertPlain200 "nyan"+    ]++--------------------------------------------------------------------------------+ captureApp :: Application-captureApp = runIdentity . runApiary def $ do+captureApp = runApp $ do     [capture|/foo|]  . action $ contentType "text/plain" >> bytes "foo"     [capture|/:Int|] . method GET . action $ \i -> contentType "text/plain" >> bytes "Int " >> showing i     [capture|/:Double|] . action $ \i -> contentType "text/plain" >> bytes "Double " >> showing i@@ -145,19 +165,19 @@  -------------------------------------------------------------------------------- -queryApp f g h = runIdentity . runApiary def $ do+queryApp f g h = runApp $ do     _ <- (f "foo" pInt)        . action $ \i -> contentType "text/plain" >> bytes "foo Int " >> showing i     _ <- (g "foo" pString)     . action $ \i -> contentType "text/plain" >> bytes "foo String " >> showing i     (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> bytes "foo Maybe String " >> showing i  queryOptionalApp :: Application-queryOptionalApp = runIdentity . runApiary def $ do+queryOptionalApp = runApp $ do     ("foo" =?!: (5 :: Int))                   . action $ \i -> contentType "text/plain" >> bytes "foo Int " >> showing i     ("foo" =?!: ("bar" :: String))            . action $ \i -> contentType "text/plain" >> bytes "foo String " >> showing i     ("foo" =?!: (Just "baz" :: Maybe String)) . action $ \i -> contentType "text/plain" >> bytes "foo Maybe String " >> showing i  queryCheckApp :: Application-queryCheckApp = runIdentity . runApiary def $ do+queryCheckApp = runApp $ do     ("foo" ?: pInt)           . action $ contentType "text/plain" >> bytes "foo Int"     ("foo" ?: pString)        . action $ contentType "text/plain" >> bytes "foo String"     ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> bytes "foo Maybe String"@@ -253,7 +273,7 @@  -------------------------------------------------------------------------------- stopApp :: Application-stopApp = runIdentity . runApiary def $ do+stopApp = runApp $ do     [capture|/a/:Int|] . action $ \i -> do         contentType "text/plain"         when (i == 1) $ bytes "one\n"@@ -272,7 +292,7 @@ --------------------------------------------------------------------------------  acceptApp :: Application-acceptApp = runIdentity . runApiary def $ [capture|/|] $ do+acceptApp = runApp $ [capture|/|] $ do     accept "application/json" . action $ bytes "json"     accept "text/html"        . action $ bytes "html"     action                             $ bytes "other"@@ -291,7 +311,7 @@ --------------------------------------------------------------------------------  multipleFilter1App :: Application-multipleFilter1App = runIdentity . runApiary def $ do+multipleFilter1App = runApp $ do     root $ do         method GET  . action $ contentType "text/plain" >> bytes "GET /"         method POST . action $ contentType "text/html"  >> bytes "POST /"@@ -315,6 +335,7 @@     , httpVersionTest     , rootFilterTest     , anyFilterTest+    , restFilterTest     , captureTest     , queryTest     , stopTest