packages feed

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 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     ]