apiary 0.8.0.0 → 0.9.0.0

raw patch · 8 files changed

+131/−34 lines, 8 filesdep +wai-extradep −transformersdep −warpdep ~waidep ~wai-testPVP ok

version bump matches the API change (PVP)

Dependencies added: wai-extra

Dependencies removed: transformers, warp

Dependency ranges changed: wai, wai-test

API changes (from Hackage documentation)

Files

• apiary.cabal +22/−8
• src/Control/Monad/Apiary/Action.hs +5/−2
• src/Control/Monad/Apiary/Action/Internal.hs +57/−8
• src/Control/Monad/Apiary/Filter.hs +18/−10
• src/Control/Monad/Apiary/Filter/Internal/Strategy.hs +0/−1
• src/Data/Apiary/Param.hs +18/−0
• src/Web/Apiary/Wai.hs +6/−0
• test/main.hs +5/−5

@@ -1,5 +1,5 @@ name:                apiary-version:             0.8.0.0+version:             0.9.0.0 synopsis:            Simple web framework inspired by scotty. description:   Simple web framework inspired by scotty.@@ -50,8 +50,13 @@ -- extra-source-files:   cabal-version:       >=1.10 +flag wai3+  description: use wai-3.0+  default: False+ library   exposed-modules:     Web.Apiary+                       Web.Apiary.Wai                         Control.Monad.Apiary                        Control.Monad.Apiary.Filter@@ -77,7 +82,6 @@                           build-depends:       base              >=4.6 && <4.8                      , template-haskell  >=2.8 && <2.10-                     , transformers      >=0.3 && <0.5                      , mtl               >=2.1 && <2.3                      , monad-control     >=0.3 && <0.4                      , transformers-base >=0.4 && <0.5@@ -85,16 +89,21 @@                      , text               >=1.1 && <1.2                      , bytestring         >=0.10 && <0.11                      , blaze-builder      >=0.3 && <0.4-                     , conduit            >=1.1 && <1.2                      , data-default-class >=0.0 && <0.1                      , tagged             >=0.7 && <0.8                      , reflection         >=1.4 && <1.5                       , http-types        >=0.8 && <0.9                      , mime-types        >=0.1 && <0.2-                     , wai               >=2.1 && <2.2-                     , warp              >=2.1 && <2.2                      , exceptions        >=0.6 && <0.7+  if flag(wai3)+    build-depends:     wai               >=3.0 && <3.1+                     , wai-extra         >=3.0 && <3.1+    cpp-options:       -DWAI3+  else+    build-depends:     wai               >=2.1 && <2.2+                     , wai-extra         >=2.1 && <2.2+                     , conduit           >=1.1 && <1.2    hs-source-dirs:      src   ghc-options:         -O2 -Wall@@ -106,11 +115,16 @@   build-depends:       base                 >=4.6 && <4.8                      , test-framework       >=0.8 && <0.9                      , test-framework-hunit >=0.3 && <0.4-                     , wai                  >=2.1 && <2.2-                     , wai-test             >=2.0 && <2.1                      , apiary                      , bytestring           >=0.10 && <0.11-                     , http-types        >=0.8 && <0.9+                     , http-types           >=0.8  && <0.9+  if flag(wai3)+    build-depends:     wai               >=3.0 && <3.1+                     , wai-test          >=3.0 && <3.1+  else+    build-depends:     wai               >=2.1 && <2.2+                     , wai-test          >=2.0 && <2.1+   hs-source-dirs:      test   ghc-options:         -O2 -Wall -fno-warn-missing-signatures   default-language:    Haskell2010

@@ -8,6 +8,8 @@     -- ** getter     , getRequest     , getHeaders+    , getReqParams+    , getReqFiles      -- ** setter     , status@@ -19,7 +21,8 @@     , file'     , builder     , lbs-    , source+    , stream+    , StreamingBody      -- ** monolithic action     -- *** redirect@@ -29,7 +32,7 @@     , module Data.Default.Class          -- * deprecated-    , redirectFound, redirectSeeOther+    , redirectFound, redirectSeeOther, source     ) where  import Control.Monad.Apiary.Action.Internal

@@ -6,6 +6,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE CPP #-}  module Control.Monad.Apiary.Action.Internal where @@ -17,6 +18,7 @@ import Control.Monad.Catch import Control.Monad.Trans.Control import Network.Wai+import Network.Wai.Parse import Network.Mime import Data.Default.Class import Network.HTTP.Types@@ -24,7 +26,10 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Text as T++#ifndef WAI3 import Data.Conduit+#endif  data ApiaryConfig = ApiaryConfig     { -- | call when no handler matched.@@ -38,10 +43,16 @@     , mimeType      :: FilePath -> S.ByteString     } +defNotFound :: Application+#ifdef WAI3+defNotFound _ 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"+#endif+ instance Default ApiaryConfig where     def = ApiaryConfig -        { notFound = \_ -> return $ responseLBS status404 -            [("Content-Type", "text/plain")] "404 Page Notfound.\n"+        { notFound      = defNotFound         , defaultStatus = ok200         , defaultHeader = []         , rootPattern   = ["", "/", "/index.html", "/index.htm"]@@ -53,20 +64,29 @@         { actionStatus  :: Status         , actionHeaders :: ResponseHeaders         , actionBody    :: Body+        , actionReqBody :: Maybe ([Param], [File L.ByteString])         } +#ifndef WAI3+type StreamingBody = Source IO (Flush Builder)+#endif+ data Body      = File FilePath (Maybe FilePart)     | Builder Builder     | LBS L.ByteString-    | SRC (Source IO (Flush Builder))+    | Str StreamingBody  actionStateToResponse :: ActionState -> Response actionStateToResponse as = case actionBody as of     File f p  -> responseFile st hd f p     Builder b -> responseBuilder st hd b     LBS l     -> responseLBS st hd l-    SRC    s  -> responseSource st hd s+#ifdef WAI3+    Str    s  -> responseStream st hd s+#else+    Str    s  -> responseSource st hd s+#endif   where     st = actionStatus  as     hd = actionHeaders as@@ -134,12 +154,22 @@ hoistActionT run m = actionT $ \c r s -> run (runActionT m c r s)  execActionT :: ApiaryConfig -> ActionT IO () -> Application++#ifdef WAI3+execActionT config m request send = runActionT m config request resp >>= \case+        Pass           -> notFound config request send+        Stop s         -> send s+        Continue (_,r) -> send $ actionStateToResponse r+  where+    resp = ActionState (defaultStatus config) (defaultHeader config) (LBS "") Nothing+#else execActionT config m request = runActionT 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 "")+    resp = ActionState (defaultStatus config) (defaultHeader config) (LBS "") Nothing+#endif  instance (Monad m, Functor m) => Alternative (ActionT m) where     empty = mzero@@ -182,6 +212,21 @@ getRequest :: Monad m => ActionT m Request getRequest = ActionT $ \_ r s c -> c r s +getRequestBody :: MonadIO m => ActionT m ([Param], [File L.ByteString])+getRequestBody = ActionT $ \_ r s c -> case actionReqBody s of+    Just b  -> c b s+    Nothing -> do+        b <- liftIO $ parseRequestBody lbsBackEnd r+        c b s { actionReqBody = Just b }++-- | parse request body and return params. since 0.9.0.0.+getReqParams :: MonadIO m => ActionT m [Param]+getReqParams = fst <$> getRequestBody++-- | parse request body and return files. since 0.9.0.0.+getReqFiles :: MonadIO m => ActionT m [File L.ByteString]+getReqFiles = snd <$> getRequestBody+ getConfig :: Monad m => ActionT m ApiaryConfig getConfig = ActionT $ \c _ s cont -> cont c s @@ -285,9 +330,13 @@ lbs :: Monad m => L.ByteString -> ActionT m () 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 src = modifyState (\s -> s { actionBody = SRC src } )+-- | set response body source. since 0.9.0.0.+stream :: Monad m => StreamingBody -> ActionT m ()+stream str = modifyState (\s -> s { actionBody = Str str })++{-# DEPRECATED source "use stream" #-}+source :: Monad m => StreamingBody -> ActionT m ()+source = stream  {-# DEPRECATED redirectFound, redirectSeeOther "use redirect" #-} -- | redirect with 302 Found. since 0.3.3.0.

@@ -5,6 +5,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Control.Monad.Apiary.Filter (     -- * filters@@ -42,6 +43,7 @@     ) 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(..))@@ -107,20 +109,26 @@ -- query "key" (Proxy :: Proxy ('Option' (Maybe Int)) -- get first \'key\' query parameter as Int. allow without param or value. -- query "key" (Proxy :: Proxy ('Many' String) -- get all \'key\' query parameter as String. -- @--- -query :: (Query a, Strategy.Strategy w, Functor n, Monad n)+query :: forall a as w n m b. +      (ReqParam a, Strategy.Strategy w, Functor n, MonadIO n)       => S.ByteString       -> Proxy (w a)       -> ApiaryT (Strategy.SNext w as a) n m b       -> ApiaryT as n m b-query k p = function $ \l r -> Strategy.readStrategy readQuery ((k ==) . fst) p (queryString r) l+query key p = focus $ \l -> do+    r     <- getRequest+    (q,f) <- getRequestBody +    maybe mzero return $+        Strategy.readStrategy id ((key ==) . fst) p +        (reqParams (Proxy :: Proxy a) r q f) l+ -- | get first matched paramerer. since 0.5.0.0. -- -- @ -- "key" =: pInt == query "key" (pFirst pInt) == query "key" (Proxy :: Proxy (First Int)) -- @-(=:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(=:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a       -> ApiaryT (Snoc as a) n m b -> ApiaryT as n m b k =: t = query k (pFirst t) @@ -131,7 +139,7 @@ -- @ -- "key" =: pInt == query "key" (pOne pInt) == query "key" (Proxy :: Proxy (One Int)) -- @-(=!:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(=!:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a        -> ApiaryT (Snoc as a) n m b -> ApiaryT as n m b k =!: t = query k (pOne t) @@ -142,7 +150,7 @@ -- @ -- "key" =: pInt == query "key" (pOption pInt) == query "key" (Proxy :: Proxy (Option Int)) -- @-(=?:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(=?:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a        -> ApiaryT (Snoc as (Maybe a)) n m b -> ApiaryT as n m b k =?: t = query k (pOption t) @@ -153,7 +161,7 @@ -- @ -- "key" =: pInt == query "key" (pCheck pInt) == query "key" (Proxy :: Proxy (Check Int)) -- @-(?:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(?:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a       -> ApiaryT as n m b -> ApiaryT as n m b k ?: t = query k (pCheck t) @@ -162,7 +170,7 @@ -- @ -- "key" =: pInt == query "key" (pMany pInt) == query "key" (Proxy :: Proxy (Many Int)) -- @-(=*:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(=*:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a        -> ApiaryT (Snoc as [a]) n m b -> ApiaryT as n m b k =*: t = query k (pMany t) @@ -171,7 +179,7 @@ -- @ -- "key" =: pInt == query "key" (pSome pInt) == query "key" (Proxy :: Proxy (Some Int)) -- @-(=+:) :: (Functor n, Monad n, Query a) => S.ByteString -> Proxy a +(=+:) :: (Functor n, MonadIO n, ReqParam a) => S.ByteString -> Proxy a        -> ApiaryT (Snoc as [a]) n m b -> ApiaryT as n m b k =+: t = query k (pSome t) @@ -181,7 +189,7 @@ -- hasQuery q = 'query' q (Proxy :: Proxy ('Check' ())) -- @ ---hasQuery :: (Functor n, Monad n) => S.ByteString -> ApiaryT c n m a -> ApiaryT c n m a+hasQuery :: (Functor n, MonadIO n) => S.ByteString -> ApiaryT c n m a -> ApiaryT c n m a hasQuery q = query q (Proxy :: Proxy (Strategy.Check ()))  --------------------------------------------------------------------------------

@@ -27,7 +27,6 @@ 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. data Option a instance Strategy Option where

@@ -6,6 +6,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverlappingInstances #-}  module Data.Apiary.Param where @@ -22,6 +24,9 @@ import Data.Proxy import Data.String(IsString) +import Network.Wai+import Network.Wai.Parse+ jsToBool :: (IsString a, Eq a) => a -> Bool jsToBool = flip notElem jsFalse     where@@ -149,3 +154,16 @@  pMaybe :: Proxy a -> Proxy (Maybe a) pMaybe _ = Proxy++pFile :: Proxy (File L.ByteString)+pFile = Proxy++class ReqParam a where+  reqParams :: Proxy a -> Request -> [Param] -> [File L.ByteString] -> [(S.ByteString, Maybe a)]++instance ReqParam (FileInfo L.ByteString) where+    reqParams _ _ _ f = map (\(k,v) -> (k, Just v)) f++instance Query a => ReqParam a where+    reqParams _ r p _ = map (\(k,v) -> (k, readQuery v)) (queryString r) +++        map (\(k,v) -> (k, readQuery $ Just v)) p

@@ -0,0 +1,6 @@+-- | reexporting Network.Wai to reduce dependencies from apiary-* packages.+module Web.Apiary.Wai+    ( module Network.Wai+    ) where++import Network.Wai

@@ -153,7 +153,7 @@   where app = queryApp (=:) (=:) (=:)  queryOneTest :: Test-queryOneTest = testGroup "First"+queryOneTest = testGroup "One"     [ testReq "GET /" $ assert404 app     , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app     , testReq "GET /?foo&foo=3" $ assert404 app@@ -165,7 +165,7 @@   where app = queryApp (=!:) (=!:) (=!:)  queryOptionTest :: Test-queryOptionTest = testGroup "First"+queryOptionTest = testGroup "Option"     [ testReq "GET /" $ assertPlain200 "foo Int Nothing" app     , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Just Nothing" app     , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Just Nothing" app@@ -177,7 +177,7 @@   where app = queryApp (=?:) (=?:) (=?:)  queryCheckTest :: Test-queryCheckTest = testGroup "First"+queryCheckTest = testGroup "Check"     [ testReq "GET /" $ assert404 app     , testReq "GET /?foo" $ assertPlain200 "foo Maybe String" app     , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String" app@@ -189,7 +189,7 @@   where app = queryCheckApp  queryManyTest :: Test-queryManyTest = testGroup "First"+queryManyTest = testGroup "Many"     [ testReq "GET /" $ assertPlain200 "foo Int []" app     , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app     , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app@@ -201,7 +201,7 @@   where app = queryApp (=*:) (=*:) (=*:)  querySomeTest :: Test-querySomeTest = testGroup "First"+querySomeTest = testGroup "Some"     [ testReq "GET /" $ assert404 app     , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app     , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app