apiary 0.5.0.0 → 0.5.1.0
raw patch · 5 files changed
+209/−70 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Control.Monad.Apiary.Filter: pCheck :: Proxy a -> Proxy (Check a)
+ Control.Monad.Apiary.Filter: pFirst :: Proxy a -> Proxy (First a)
+ Control.Monad.Apiary.Filter: pMany :: Proxy a -> Proxy (Many a)
+ Control.Monad.Apiary.Filter: pOne :: Proxy a -> Proxy (One a)
+ Control.Monad.Apiary.Filter: pOption :: Proxy a -> Proxy (Option a)
+ Control.Monad.Apiary.Filter: pSome :: Proxy a -> Proxy (Some a)
+ Control.Monad.Apiary.Filter: query :: (Query a, Strategy w, Monad m) => ByteString -> Proxy (w a) -> ApiaryT (SNext w as a) m b -> ApiaryT as m b
+ Control.Monad.Apiary.Filter.Internal.Query: pCheck :: Proxy a -> Proxy (Check a)
+ Control.Monad.Apiary.Filter.Internal.Query: pFirst :: Proxy a -> Proxy (First a)
+ Control.Monad.Apiary.Filter.Internal.Query: pMany :: Proxy a -> Proxy (Many a)
+ Control.Monad.Apiary.Filter.Internal.Query: pOne :: Proxy a -> Proxy (One a)
+ Control.Monad.Apiary.Filter.Internal.Query: pOption :: Proxy a -> Proxy (Option a)
+ Control.Monad.Apiary.Filter.Internal.Query: pSome :: Proxy a -> Proxy (Some a)
Files
- apiary.cabal +3/−2
- src/Control/Monad/Apiary/Filter.hs +16/−31
- src/Control/Monad/Apiary/Filter/Internal/Capture.hs +1/−1
- src/Control/Monad/Apiary/Filter/Internal/Query.hs +24/−0
- test/main.hs +165/−36
apiary.cabal view
@@ -1,5 +1,5 @@ name: apiary-version: 0.5.0.0+version: 0.5.1.0 x-revision: 1 synopsis: Simple web framework inspired by scotty. description:@@ -109,8 +109,9 @@ , wai-test >=2.0 && <2.1 , apiary , bytestring >=0.10 && <0.11+ , http-types >=0.8 && <0.9 hs-source-dirs: test- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fno-warn-missing-signatures default-language: Haskell2010 source-repository head
src/Control/Monad/Apiary/Filter.hs view
@@ -15,9 +15,13 @@ , capture -- ** query matcher+ , query+ , pFirst, pOne, pOption, pCheck, pMany, pSome+ -- *** specified operators , (=:), (=!:), (=?:), (?:), (=*:), (=+:) , hasQuery + -- ** other , ssl @@ -83,81 +87,62 @@ -- | get first matched paramerer. since 0.5.0.0. -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (First Int))+-- "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-k =: t = query k (asFirst t)- where- asFirst :: Proxy a -> Proxy (First a)- asFirst _ = Proxy-+k =: t = query k (pFirst t) -- | get one matched paramerer. since 0.5.0.0. -- -- when more one parameger given, not matched. -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (One Int))+-- "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-k =!: t = query k (asOne t)- where- asOne :: Proxy a -> Proxy (One a)- asOne _ = Proxy+k =!: t = query k (pOne t) -- | get optional first paramerer. since 0.5.0.0. -- -- when illegal type parameter given, fail mather(don't give Nothing). -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (Option Int))+-- "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-k =?: t = query k (asOption t)- where- asOption :: Proxy a -> Proxy (Option a)- asOption _ = Proxy+k =?: t = query k (pOption t) -- | check parameger given and type. since 0.5.0.0. -- -- If you wan't to allow any type, give 'pVoid'. -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (Check Int))+-- "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-k ?: t = query k (asCheck t)- where- asCheck :: Proxy a -> Proxy (Check a)- asCheck _ = Proxy+k ?: t = query k (pCheck t) -- | get many paramerer. since 0.5.0.0. -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (Many Int))+-- "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-k =*: t = query k (asMany t)- where- asMany :: Proxy a -> Proxy (Many a)- asMany _ = Proxy+k =*: t = query k (pMany t) -- | get some paramerer. since 0.5.0.0. -- -- @--- "key" =: pInt == query "key" (Proxy :: Proxy (Some Int))+-- "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-k =+: t = query k (asSome t)- where- asSome :: Proxy a -> Proxy (Some a)- asSome _ = Proxy+k =+: t = query k (pSome t) -- | query exists checker. --
src/Control/Monad/Apiary/Filter/Internal/Capture.hs view
@@ -55,7 +55,7 @@ -- -- @ -- myCapture :: 'SList' '['Equal', 'Fetch' Int, Fetch String]--- myCapture = 'Equal' "path" ':::' 'pInt' ::: 'pString' ::: 'SNil'+-- myCapture = 'Equal' \"path\" ':::' 'pInt' ::: 'pString' ::: 'SNil' -- -- capture myCapture . stdMethod GET . action $ \age name -> do -- yourAction
src/Control/Monad/Apiary/Filter/Internal/Query.hs view
@@ -123,3 +123,27 @@ else case catMaybes rs of [] -> Nothing _ -> Just l++-- | construct Option proxy. since 0.5.1.0.+pOption :: Proxy a -> Proxy (Option a)+pOption _ = Proxy++-- | construct First proxy. since 0.5.1.0.+pFirst :: Proxy a -> Proxy (First a)+pFirst _ = Proxy++-- | construct One proxy. since 0.5.1.0.+pOne :: Proxy a -> Proxy (One a)+pOne _ = Proxy++-- | construct Many proxy. since 0.5.1.0.+pMany :: Proxy a -> Proxy (Many a)+pMany _ = Proxy++-- | construct Some proxy. since 0.5.1.0.+pSome :: Proxy a -> Proxy (Some a)+pSome _ = Proxy++-- | construct Check proxy. since 0.5.1.0.+pCheck :: Proxy a -> Proxy (Check a)+pCheck _ = Proxy
test/main.hs view
@@ -7,26 +7,22 @@ import Web.Apiary import Network.Wai import Network.Wai.Test--import qualified Data.ByteString.Lazy as L--getRoot :: Request-getRoot = defaultRequest--postRoot :: Request-postRoot = defaultRequest { requestMethod = "POST" }--deleteRoot :: Request-deleteRoot = defaultRequest { requestMethod = "DELETE" }--putRoot :: Request-putRoot = defaultRequest { requestMethod = "PUT" }+import qualified Network.HTTP.Types as HTTP -getIndexHtml :: Request-getIndexHtml = setPath defaultRequest "/index.html"+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.ByteString.Char8 as S -getNeko :: Request-getNeko = setPath defaultRequest "/neko"+testReq :: String -> (Request -> IO ()) -> Test+testReq str f = + let (meth, other) = break (== ' ') str+ (path, version) = break (== ' ') (tail other)+ in testCase str $ f (setPath (setVersion version $ (defaultRequest { requestMethod = S.pack meth })) (S.pack path))+ where+ setVersion [] r = r+ setVersion v r | v == " HTTP/1.1" = r { Network.Wai.httpVersion = HTTP.http11 }+ | v == " HTTP/1.0" = r { Network.Wai.httpVersion = HTTP.http10 }+ | v == " HTTP/0.9" = r { Network.Wai.httpVersion = HTTP.http09 }+ | otherwise = error "unknown HTTP version" -------------------------------------------------------------------------------- @@ -60,9 +56,9 @@ helloWorldAllTest :: Test helloWorldAllTest = testGroup "helloWorld" - [ testCase "GET /" $ assertPlain200 "hello" helloWorldApp getRoot- , testCase "GET /neko" $ assertPlain200 "hello" helloWorldApp getNeko- , testCase "POST /" $ assertPlain200 "hello" helloWorldApp postRoot+ [ testReq "GET /" $ assertPlain200 "hello" helloWorldApp+ , testReq "GET /foo" $ assertPlain200 "hello" helloWorldApp+ , testReq "POST /" $ assertPlain200 "hello" helloWorldApp ] --------------------------------------------------------------------------------@@ -74,13 +70,29 @@ methodFilterTest :: Test methodFilterTest = testGroup "methodFilter"- [ testCase "GET /" $ assertPlain200 "GET" methodFilterApp getRoot- , testCase "POST /" $ assertPlain200 "POST" methodFilterApp postRoot- , testCase "GET /neko" $ assertPlain200 "GET" methodFilterApp getNeko- , testCase "DELETE /" $ assert404 methodFilterApp deleteRoot+ [ testReq "GET /" $ assertPlain200 "GET" methodFilterApp+ , testReq "POST /" $ assertPlain200 "POST" methodFilterApp+ , testReq "GET /foo" $ assertPlain200 "GET" methodFilterApp+ , testReq "DELETE /" $ assert404 methodFilterApp ] --------------------------------------------------------------------------------++httpVersionApp :: Application+httpVersionApp = runApiary def $ do+ http09 . action $ contentType "text/plain" >> lbs "09"+ http10 . action $ contentType "text/plain" >> lbs "10"+ http11 . action $ contentType "text/plain" >> lbs "11"++httpVersionTest :: Test+httpVersionTest = testGroup "httpVersionFilter" + [ testReq "GET / HTTP/0.9" $ assertPlain200 "09" httpVersionApp+ , testReq "GET / HTTP/1.0" $ assertPlain200 "10" httpVersionApp+ , testReq "GET / HTTP/1.1" $ assertPlain200 "11" httpVersionApp+ ]++--------------------------------------------------------------------------------+ rootFilterApp :: Application rootFilterApp = runApiary def . root . action $ do contentType "text/html"@@ -88,14 +100,131 @@ rootFilterTest :: Test rootFilterTest = testGroup "rootFilter"- [ testCase "GET /" $ assertHtml200 "root" rootFilterApp getRoot- , testCase "POST /" $ assertHtml200 "root" rootFilterApp postRoot- , testCase "GET /neko" $ assert404 rootFilterApp getNeko- , testCase "GET /index.html" $ assertHtml200 "root" rootFilterApp getIndexHtml+ [ testReq "GET /" $ assertHtml200 "root" rootFilterApp+ , testReq "POST /" $ assertHtml200 "root" rootFilterApp+ , testReq "GET /neko" $ assert404 rootFilterApp+ , testReq "GET /index.html" $ assertHtml200 "root" rootFilterApp ] -------------------------------------------------------------------------------- +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|/: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])++captureTest :: Test+captureTest = testGroup "capture"+ [ testReq "GET /foo" $ assertPlain200 "foo" captureApp+ , testReq "GET /12" $ assertPlain200 "Int 12" captureApp+ , testReq "GET /12.4" $ assertPlain200 "Double 12.4" captureApp+ , testReq "POST /12" $ assertPlain200 "Double 12.0" captureApp+ , testReq "GET /bar" $ assertPlain200 "fall bar" captureApp+ , testReq "GET /baz" $ assertPlain200 "fall baz" captureApp+ , testReq "GET /bar/nyan/12" $ assertPlain200 "nyan 12" captureApp+ ]++--------------------------------------------------------------------------------++queryApp f g h = runApiary def $ do+ _ <- (f "foo" pInt) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Int", L.pack $ show i])+ _ <- (g "foo" pString) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "String", L.pack $ show i])+ (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String", L.pack $ show i])++queryCheckApp :: Application+queryCheckApp = runApiary def $ do+ ("foo" ?: pInt) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Int"])+ ("foo" ?: pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "String"])+ ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String"])++queryFirstTest :: Test+queryFirstTest = testGroup "First"+ [ testReq "GET /" $ assert404 app+ , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app+ , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Nothing" app+ , 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+ ]+ where app = queryApp (=:) (=:) (=:)++queryOneTest :: Test+queryOneTest = testGroup "First"+ [ testReq "GET /" $ assert404 app+ , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app+ , testReq "GET /?foo&foo=3" $ assert404 app+ , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app+ , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app+ , testReq "GET /?foo=12&foo=23" $ assert404 app+ , testReq "GET /?foo=12&foo=b" $ assert404 app+ ]+ where app = queryApp (=!:) (=!:) (=!:)++queryOptionTest :: Test+queryOptionTest = testGroup "First"+ [ 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+ , testReq "GET /?foo=12" $ assertPlain200 "foo Int Just 12" app+ , testReq "GET /?foo=a" $ assertPlain200 "foo String Just \"a\"" app+ , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int Just 12" app+ , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String Just \"12\"" app+ ]+ where app = queryApp (=?:) (=?:) (=?:)++queryCheckTest :: Test+queryCheckTest = testGroup "First"+ [ testReq "GET /" $ assert404 app+ , testReq "GET /?foo" $ assertPlain200 "foo Maybe String" app+ , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String" app+ , testReq "GET /?foo=12" $ assertPlain200 "foo Int" app+ , testReq "GET /?foo=a" $ assertPlain200 "foo String" app+ , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int" app+ , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String" app+ ]+ where app = queryCheckApp++queryManyTest :: Test+queryManyTest = testGroup "First"+ [ 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+ , 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,23]" app+ , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app+ ]+ where app = queryApp (=*:) (=*:) (=*:)++querySomeTest :: Test+querySomeTest = testGroup "First"+ [ 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+ , 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,23]" app+ , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app+ ]+ where app = queryApp (=+:) (=+:) (=+:)+++queryTest :: Test+queryTest = testGroup "query"+ [ queryFirstTest+ , queryOneTest+ , queryOptionTest+ , queryCheckTest+ , queryManyTest+ , querySomeTest+ ]++--------------------------------------------------------------------------------+ multipleFilter1App :: Application multipleFilter1App = runApiary def $ do root $ do@@ -106,23 +235,23 @@ multipleFilter1Test :: Test multipleFilter1Test = testGroup "multiple test1: root, method"- [ testCase "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App getIndexHtml- , testCase "POST /" $ assertHtml200 "POST /" multipleFilter1App postRoot- , testCase "DELETE /" $ assertPlain200 "DELETE ANY" multipleFilter1App deleteRoot- , testCase "PUT /" $ assert404 multipleFilter1App putRoot+ [ testReq "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App+ , testReq "POST /" $ assertHtml200 "POST /" multipleFilter1App+ , testReq "DELETE /" $ assertPlain200 "DELETE ANY" multipleFilter1App + , testReq "PUT /" $ assert404 multipleFilter1App ] -------------------------------------------------------------------------------- ----------------------------------------------------------------------------------- main :: IO () main = defaultMain [ helloWorldAllTest , methodFilterTest+ , httpVersionTest , rootFilterTest+ , captureTest+ , queryTest , multipleFilter1Test ]