apiary 0.4.3.2 → 0.5.0.0

raw patch · 14 files changed

+551/−192 lines, 14 filesdep +taggeddep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: tagged

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• apiary.cabal +21/−8
• src/Control/Monad/Apiary.hs +0/−3
• src/Control/Monad/Apiary/Action/Internal.hs +5/−1
• src/Control/Monad/Apiary/Filter.hs +150/−46
• src/Control/Monad/Apiary/Filter/Capture.hs +0/−62
• src/Control/Monad/Apiary/Filter/Internal.hs +22/−0
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +64/−0
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +40/−0
• src/Control/Monad/Apiary/Filter/Internal/Query.hs +125/−0
• src/Data/Apiary/Param.hs +112/−24
• src/Web/Apiary.hs +5/−3
• src/Web/Apiary/TH.hs +0/−5
• src/Web/Apiary/TH/Internal.hs +0/−39
• test/main.hs +7/−1

@@ -1,5 +1,5 @@ name:                apiary-version:             0.4.3.2+version:             0.5.0.0 x-revision:          1 synopsis:            Simple web framework inspired by scotty. description:@@ -15,12 +15,23 @@   .   main :: IO ()   main = run 3000 . runApiary def $ do-  &#32;&#32;[capture|/:Int|] . queryFirst' &#34;name&#34; . stdMethod GET . action $ \\age name -> do+  &#32;&#32;[capture|/:Int|] . (&#34;name&#34; =: pLazyByteString) . stdMethod GET . action $ \\age name -> do   &#32;&#32;&#32;&#32;&#32;&#32;guard (age >= 18)   &#32;&#32;&#32;&#32;&#32;&#32;contentType &#34;text/html&#34;-  &#32;&#32;&#32;&#32;&#32;&#32;lbs . L.concat $ [&#34;&#60;h1&#62;Hello, &#34;, L.fromStrict name, &#34;!&#60;/h1&#62;&#34;]+  &#32;&#32;&#32;&#32;&#32;&#32;lbs . L.concat $ [&#34;&#60;h1&#62;Hello, &#34;, name, &#34;!&#60;/h1&#62;\\n&#34;]   @   .+  @+  $ curl localhost:3000+  404 Page Notfound.+  $ curl 'localhost:3000/20?name=arice'+  &#60;h1&#62;Hello, arice!&#60;/h1&#62;+  $ curl 'localhost:3000/15?name=bob'+  404 Page Notfound.+  $ curl -XPOST 'localhost:3000/20?name=arice'+  404 Page Notfound.+  @+  .     * Nestable route handling(ApiaryT Monad; capture, stdMethod and more.).   .     * type safe route filter.@@ -42,19 +53,20 @@  library   exposed-modules:     Web.Apiary-                       Web.Apiary.TH                         Control.Monad.Apiary                        Control.Monad.Apiary.Filter-                       Control.Monad.Apiary.Filter.Capture+                       Control.Monad.Apiary.Filter.Internal+                       Control.Monad.Apiary.Filter.Internal.Capture+                       Control.Monad.Apiary.Filter.Internal.Query                        Control.Monad.Apiary.Action                         Data.Apiary.SList                        Data.Apiary.Param -  other-modules:       Web.Apiary.TH.Internal-                       Control.Monad.Apiary.Internal+  other-modules:       Control.Monad.Apiary.Internal                        Control.Monad.Apiary.Action.Internal+                       Control.Monad.Apiary.Filter.Internal.Capture.TH   other-extensions:    KindSignatures                      , DataKinds                      , TypeOperators@@ -76,6 +88,7 @@                      , conduit            >=1.1 && <1.2                      , monad-logger       >=0.3 && <0.4                      , data-default-class >=0.0 && <0.1+                     , tagged             >=0.7 && <0.8                       , http-types        >=0.8 && <0.9                      , mime-types        >=0.1 && <0.2@@ -89,7 +102,7 @@ test-suite test-framework   main-is:             main.hs   type:                exitcode-stdio-1.0-  build-depends:       base                 >=4.5 && <4.8+  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

@@ -7,9 +7,6 @@     , apiaryConfig     -- * execute action     , action, action_, actionWithPreAction-    -- * Reexport-    , module Control.Monad.Apiary.Filter     ) where  import Control.Monad.Apiary.Internal-import Control.Monad.Apiary.Filter

@@ -42,7 +42,7 @@ instance Default ApiaryConfig where     def = ApiaryConfig          { notFound = \_ -> return $ responseLBS status404 -            [("Content-Type", "text/plain")] "404 Page Notfound."+            [("Content-Type", "text/plain")] "404 Page Notfound.\n"         , defaultStatus = ok200         , defaultHeader = []         , rootPattern   = ["", "/", "/index.html", "/index.htm"]@@ -201,8 +201,12 @@ getQuery' :: Monad m => S.ByteString -> ActionT m (Maybe S.ByteString) getQuery' q = getQuery q >>= maybe mzero return +{-# DEPRECATED getQuery' "use qeury derived filter." #-}+ getQuery :: Monad m => S.ByteString -> ActionT m (Maybe (Maybe S.ByteString)) getQuery q = (lookup q . queryString) `liftM` getRequest++{-# DEPRECATED getQuery "use qeury derived filter." #-}  status :: Monad m => Status -> ActionT m () status st = modifyState (\s -> s { actionStatus = st } )

@@ -3,54 +3,177 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-} -module Control.Monad.Apiary.Filter-    ( method, stdMethod, root+module Control.Monad.Apiary.Filter (+    -- * filters+    -- ** http method+      method, stdMethod+    -- ** http version+    , Control.Monad.Apiary.Filter.httpVersion+    , http09, http10, http11+    -- ** path matcher+    , root+    , capture++    -- ** query matcher+    , (=:), (=!:), (=?:), (?:), (=*:), (=+:)+    , hasQuery++    -- ** other     , ssl-    -- * query parameter-    -- ** query getter(always success)-    , queryMany, queryMany'-    , maybeQueryFirst, maybeQueryFirst'-    -- ** query filter-    , querySome, querySome'-    , queryFirst, queryFirst'-    -- * low level-    , function, function'+         -- * Reexport     -- StdMethod(..)     , module Network.HTTP.Types     -- * deprecated-    , hasQuery, queryAll, queryAll'+    , queryAll,        queryAll'+    , querySome,       querySome'+    , queryFirst,      queryFirst'+    , queryMany,       queryMany'+    , maybeQueryFirst, maybeQueryFirst'     ) where  import Control.Monad-import Network.Wai-import qualified Network.HTTP.Types as Use+import Network.Wai as Wai+import qualified Network.HTTP.Types as HT import Network.HTTP.Types (StdMethod(..)) import qualified Data.ByteString as S import Data.Maybe+import Data.Proxy  import Data.Apiary.SList+import Data.Apiary.Param  import Control.Monad.Apiary.Action.Internal+import Control.Monad.Apiary.Filter.Internal+import Control.Monad.Apiary.Filter.Internal.Query+import Control.Monad.Apiary.Filter.Internal.Capture.TH import Control.Monad.Apiary.Internal --- | raw and most generic filter function.-function :: Monad m => (SList c -> Request -> Maybe (SList c')) -> ApiaryT c' m b -> ApiaryT c m b-function f = focus $ \r c -> case f c r of-    Nothing -> mzero-    Just c' -> return c'+ssl :: Monad m => ApiaryT c m a -> ApiaryT c m a+ssl = function_ isSecure --- | filter and append argument.-function' :: Monad m => (Request -> Maybe a) -> ApiaryT (Snoc as a) m b -> ApiaryT as m b-function' f = function $ \c r -> sSnoc c `fmap` f r+-- | http version filter. since 0.5.0.0.+httpVersion :: Monad m => HT.HttpVersion  -> ApiaryT c m b -> ApiaryT c m b+httpVersion v = function_ $ (v ==) . Wai.httpVersion --- | filter only(not modify arguments).-function_ :: Monad m => (Request -> Bool) -> ApiaryT c m b -> ApiaryT c m b-function_ f = function $ \c r -> if f r then Just c else Nothing+-- | http/0.9 only accepted fiter. since 0.5.0.0.+http09 :: Monad m => ApiaryT c m b -> ApiaryT c m b+http09 = Control.Monad.Apiary.Filter.httpVersion HT.http09 -ssl :: Monad m => ApiaryT c m a -> ApiaryT c m a-ssl = function_ isSecure+-- | http/1.0 only accepted fiter. since 0.5.0.0.+http10 :: Monad m => ApiaryT c m b -> ApiaryT c m 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 = Control.Monad.Apiary.Filter.httpVersion HT.http11++method :: Monad m => HT.Method -> ApiaryT c m a -> ApiaryT c m a+method m = function_ ((m ==) . requestMethod)++stdMethod :: Monad m => StdMethod -> ApiaryT c m a -> ApiaryT c m a+stdMethod = method . HT.renderStdMethod++-- | 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 m = do+    rs <- rootPattern `liftM` apiaryConfig+    function_ (\r -> rawPathInfo r `elem` rs) m++-- | get first matched paramerer. since 0.5.0.0.+--+-- @+-- "key" =: 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+++-- | get one matched paramerer. since 0.5.0.0.+--+-- when more one parameger given, not matched.+--+-- @+-- "key" =: 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++-- | 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))+-- @+(=?:) :: (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++-- | 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))+-- @+(?:) :: (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++-- | get many paramerer. since 0.5.0.0.+--+-- @+-- "key" =: 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++-- | get some paramerer. since 0.5.0.0.+--+-- @+-- "key" =: 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++-- | query exists checker.+--+-- @+-- hasQuery q = 'query' q (Proxy :: Proxy ('Check' ()))+-- @+--+hasQuery :: Monad m => S.ByteString -> ApiaryT c m a -> ApiaryT c m a+hasQuery q = query q (Proxy :: Proxy (Check ()))++--------------------------------------------------------------------------------++{-# DEPRECATED queryMany, querySome, queryAll, queryMany', querySome', queryAll'+  , maybeQueryFirst, queryFirst, maybeQueryFirst'+  , queryFirst' "use query related filters" #-}+ -- | get [0,) parameters by query parameter allows empty value. since 0.4.3.0. queryMany :: Monad m => S.ByteString           -> ApiaryT (Snoc as [Maybe S.ByteString]) m b@@ -70,7 +193,6 @@          -> ApiaryT (Snoc as [Maybe S.ByteString]) m b -- ^ Nothing == no value paramator.          -> ApiaryT as m b queryAll = querySome-{-# DEPRECATED queryAll "use querySome" #-}  -- | get [0,) parameters by query parameter not allows empty value. since 0.4.3.0. queryMany' :: Monad m => S.ByteString@@ -91,7 +213,6 @@           -> ApiaryT (Snoc as [S.ByteString]) m b            -> ApiaryT as m b queryAll' = querySome'-{-# DEPRECATED queryAll' "use querySome'" #-}  -- | get first query parameter allow empty value. since 0.4.3.0, maybeQueryFirst :: Monad m => S.ByteString@@ -116,20 +237,3 @@             -> ApiaryT (Snoc as S.ByteString) m b             -> ApiaryT as m b queryFirst' q = function' $ listToMaybe . mapMaybe snd . filter ((q ==) . fst) . queryString--hasQuery :: Monad m => S.ByteString -> ApiaryT c m a -> ApiaryT c m a-hasQuery q = function_ (any ((q ==) . fst) . queryString)--{-# DEPRECATED hasQuery "use query* function." #-}--method :: Monad m => Use.Method -> ApiaryT c m a -> ApiaryT c m a-method m = function_ ((m ==) . requestMethod)--stdMethod :: Monad m => StdMethod -> ApiaryT c m a -> ApiaryT c m a-stdMethod = method . Use.renderStdMethod---- | 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 m = do-    rs <- rootPattern `liftM` apiaryConfig-    function_ (\r -> rawPathInfo r `elem` rs) m

@@ -1,62 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Control.Monad.Apiary.Filter.Capture where--import Network.Wai--import Control.Applicative-import qualified Data.Text as T-import Data.Apiary.Param-import Data.Apiary.SList--import Control.Monad.Apiary--data Equal   = Equal T.Text-data Fetch a = Fetch--class CaptureElem a where-  type Next a (xs :: [*]) :: [*]-  captureElem :: a -> T.Text -> SList xs -> Maybe (SList (Next a xs))--instance CaptureElem Equal where-    type Next Equal xs = xs-    captureElem (Equal s) p c | s == p    = Just c-                              | otherwise = Nothing--instance Param a => CaptureElem (Fetch a) where-    type Next (Fetch a) xs = (xs `Snoc` a)-    captureElem (Fetch :: Fetch a) p c = (sSnoc c) <$> (readParam p :: Maybe a)---type Capture as = All CaptureElem as--type family   CaptureResult (bf :: [*]) (as :: [*]) :: [*]-type instance CaptureResult bf '[] = bf-type instance CaptureResult bf (a ': as) = (CaptureResult (Next a bf) as)--capture' :: Capture as => SList as -> [T.Text] -> SList xs -> Maybe (SList (CaptureResult xs as))-capture' SNil       []     bf = Just bf-capture' (c ::: cs) (p:ps) bf = captureElem c p bf >>= capture' cs ps-capture' SNil _ _ = Nothing-capture' _ [] _   = Nothing---- | low level (without Template Haskell) capture. since 0.4.2.0------ @--- myCapture :: SList '[Equal, Fetch Int, Fetch String]--- myCapture = Equal "path" ::: (Fetch :: Fetch Int) ::: (Fetch :: Fetch String) ::: SNil------ 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 cap = function $ \bf req -> capture' cap (pathInfo req) bf

@@ -0,0 +1,22 @@+module Control.Monad.Apiary.Filter.Internal where++import Control.Monad+import Control.Monad.Apiary.Internal+import Network.Wai+import Data.Apiary.SList++-- | raw and most generic filter function.+function :: Monad m => (SList c -> Request -> Maybe (SList c')) -> ApiaryT c' m b -> ApiaryT c m b+function f = focus $ \r c -> 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' 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_ f = function $ \c r -> if f r then Just c else Nothing++

@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Control.Monad.Apiary.Filter.Internal.Capture where++import Network.Wai++import Control.Applicative+import qualified Data.Text as T+import Data.Apiary.Param+import Data.Apiary.SList+import Data.Proxy++import Control.Monad.Apiary+import Control.Monad.Apiary.Filter.Internal++data Equal   = Equal T.Text+type Fetch = Proxy++class CaptureElem a where+  type Next a (xs :: [*]) :: [*]+  captureElem :: a -> T.Text -> SList xs -> Maybe (SList (Next a xs))++instance CaptureElem Equal where+    type Next Equal xs = xs+    captureElem (Equal s) p c | s == p    = Just c+                              | otherwise = Nothing++instance Path a => CaptureElem (Fetch a) where+    type Next (Fetch a) xs = (xs `Snoc` a)+    captureElem (Proxy :: Fetch a) p c = (sSnoc c) <$> (readPath p :: Maybe a)++type Capture as = All CaptureElem as++type family   CaptureResult (bf :: [*]) (as :: [*]) :: [*]+type instance CaptureResult bf '[] = bf+type instance CaptureResult bf (a ': as) = (CaptureResult (Next a bf) as)++capture' :: Capture as => SList as -> [T.Text] -> SList xs -> Maybe (SList (CaptureResult xs as))+capture' SNil       []     bf = Just bf+capture' (c ::: cs) (p:ps) bf = captureElem c p bf >>= capture' cs ps+capture' SNil _ _ = Nothing+capture' _ [] _   = Nothing++-- | low level (without Template Haskell) capture. since 0.4.2.0+--+-- @+-- myCapture :: 'SList' '['Equal', 'Fetch' Int, Fetch String]+-- myCapture = 'Equal' "path" ':::' 'pInt' ::: 'pString' ::: 'SNil'+--+-- 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 cap = function $ \bf req -> capture' cap (pathInfo req) bf

@@ -0,0 +1,40 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Control.Monad.Apiary.Filter.Internal.Capture.TH where++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture+import Data.Apiary.SList+import qualified Data.Text as T+import Data.Proxy++preCap :: String -> [String]+preCap ""  = []+preCap "/" = []+preCap ('/':p) = splitPath p+preCap p       = splitPath p++splitPath :: String -> [String]+splitPath = map T.unpack . T.splitOn "/" . T.pack++mkCap :: [String] -> ExpQ+mkCap [] = [|SNil|]+mkCap ((':':tyStr):as) = do+    -- ty <- lookupTypeName tyStr >>= maybe (fail "") return+    let ty = mkName tyStr+    [|(Proxy :: Capture.Fetch $(conT ty)) ::: $(mkCap as) |]+mkCap (eq:as) = do+    [|(Capture.Equal $(stringE eq)) ::: $(mkCap as) |]++applyCapture :: ExpQ -> ExpQ+applyCapture e = [|Capture.capture $e|]++capture :: QuasiQuoter+capture = QuasiQuoter +    { quoteExp = applyCapture . mkCap . preCap+    , quotePat  = \_ -> error "No quotePat."+    , quoteType = \_ -> error "No quoteType."+    , quoteDec  = \_ -> error "No quoteDec."+    }+

@@ -0,0 +1,125 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Control.Monad.Apiary.Filter.Internal.Query where++import Control.Monad.Apiary+import Control.Monad.Apiary.Filter.Internal+import Data.Apiary.Param+import Data.Apiary.SList++import Network.Wai+import qualified Network.HTTP.Types as HTTP++import qualified Data.ByteString as S+import Data.Maybe+import Data.Proxy++-- | low level query getter. since 0.5.0.0.+--+-- @+-- query "key" (Proxy :: Proxy (fetcher type))+-- @+--+-- examples:+--+-- @+-- query "key" (Proxy :: Proxy ('First' Int)) -- get first \'key\' query parameter as Int.+-- 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 w, Monad m)+      => S.ByteString+      -> Proxy (w a)+      -> ApiaryT (SNext w as a) m b+      -> ApiaryT as m b+query k p = function $ \l r -> readStrategy k p (queryString r) l++--------------------------------------------------------------------------------++class Strategy (w :: * -> *) where+  type SNext w (as :: [*]) a  :: [*]+  readStrategy :: Query a => S.ByteString -> Proxy (w a)+            -> HTTP.Query -> SList as -> Maybe (SList (SNext w as a))++getQuery :: Query a => Proxy (w a) -> S.ByteString -> HTTP.Query -> [Maybe a]+getQuery _ k = map readQuery . map snd . filter ((k ==) . fst)++-- | get first matched key( [1,) params to Type.). since 0.5.0.0.+data Option a+instance Strategy Option where+    type SNext Option as a = Snoc as (Maybe a)+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               []  -> Just $ sSnoc l (Nothing `asMaybe` p)+               a:_ -> Just $ sSnoc l (Just a)+      where+        asMaybe :: Maybe a -> Proxy (w a) -> Maybe a+        asMaybe a _ = asProxyTypeOf a Proxy++-- | get first matched key ( [0,) params to Maybe Type.) since 0.5.0.0.+data First a+instance Strategy First where+    type SNext First as a = Snoc as a+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               [] -> Nothing+               a:_ -> Just $ sSnoc l a++-- | get key ( [1] param to Type.) since 0.5.0.0.+data One a+instance Strategy One where+    type SNext One as a = Snoc as a+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               [a] -> Just $ sSnoc l a+               _   -> Nothing++-- | get parameters ( [0,) params to [Type] ) since 0.5.0.0.+data Many a+instance Strategy Many where+    type SNext Many as a = Snoc as [a]+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else Just $ sSnoc l (catMaybes rs)++-- | get parameters ( [1,) params to [Type] ) since 0.5.0.0.+data Some a+instance Strategy Some where+    type SNext Some as a = Snoc as [a]+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               [] -> Nothing+               as -> Just $ sSnoc l as++-- | type check ( [0,) params to No argument ) since 0.5.0.0.+data Check a+instance Strategy Check where+    type SNext Check as a = as+    readStrategy k p q l =+        let rs = getQuery p k q+        in if any isNothing rs+           then Nothing+           else case  catMaybes rs of+               [] -> Nothing+               _  -> Just l

@@ -1,43 +1,131 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.Apiary.Param where  import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L+import Data.Text.Encoding.Error import Text.Read import Data.Int import Data.Word+import Data.Proxy -class Param a where-  readParam :: T.Text -> Maybe a+class Path a where+  readPath :: T.Text -> Maybe a -instance Param Char where-    readParam s | T.null s  = Nothing-                | otherwise = Just $ T.head s+instance Path Char where+    readPath    s | T.null s  = Nothing+                  | otherwise = Just $ T.head s -instance Param Int     where readParam = readMaybe . T.unpack-instance Param Int8    where readParam = readMaybe . T.unpack-instance Param Int16   where readParam = readMaybe . T.unpack-instance Param Int32   where readParam = readMaybe . T.unpack-instance Param Int64   where readParam = readMaybe . T.unpack-instance Param Integer where readParam = readMaybe . T.unpack+instance Path Int     where readPath    = readMaybe . T.unpack+instance Path Int8    where readPath    = readMaybe . T.unpack+instance Path Int16   where readPath    = readMaybe . T.unpack+instance Path Int32   where readPath    = readMaybe . T.unpack+instance Path Int64   where readPath    = readMaybe . T.unpack+instance Path Integer where readPath    = readMaybe . T.unpack -instance Param Word   where readParam = readMaybe . T.unpack-instance Param Word8  where readParam = readMaybe . T.unpack-instance Param Word16 where readParam = readMaybe . T.unpack-instance Param Word32 where readParam = readMaybe . T.unpack-instance Param Word64 where readParam = readMaybe . T.unpack+instance Path Word   where readPath    = readMaybe . T.unpack+instance Path Word8  where readPath    = readMaybe . T.unpack+instance Path Word16 where readPath    = readMaybe . T.unpack+instance Path Word32 where readPath    = readMaybe . T.unpack+instance Path Word64 where readPath    = readMaybe . T.unpack -instance Param Double  where readParam = readMaybe . T.unpack-instance Param Float   where readParam = readMaybe . T.unpack+instance Path Double  where readPath    = readMaybe . T.unpack+instance Path Float   where readPath    = readMaybe . T.unpack -instance Param T.Text where-    readParam = Just+instance Path  T.Text      where readPath    = Just+instance Path TL.Text      where readPath    = Just . TL.fromStrict+instance Path S.ByteString where readPath    = Just . T.encodeUtf8+instance Path L.ByteString where readPath    = Just . TL.encodeUtf8 . TL.fromStrict+instance Path String       where readPath    = Just . T.unpack -instance Param TL.Text where-    readParam = Just . TL.fromStrict+-------------------------------------------------------------------------------- -instance Param String where-    readParam = Just . T.unpack+class Query a where+    readQuery :: Maybe S.ByteString -> Maybe a +instance Query Int     where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Int8    where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Int16   where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Int32   where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Int64   where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Integer where readQuery = maybe Nothing (readMaybe . S.unpack)++instance Query Word   where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Word8  where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Word16 where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Word32 where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Word64 where readQuery = maybe Nothing (readMaybe . S.unpack)++instance Query Double where readQuery = maybe Nothing (readMaybe . S.unpack)+instance Query Float  where readQuery = maybe Nothing (readMaybe . S.unpack)++instance Query T.Text       where readQuery = fmap $ T.decodeUtf8With lenientDecode+instance Query TL.Text      where readQuery = fmap (TL.decodeUtf8With lenientDecode . L.fromStrict)+instance Query S.ByteString where readQuery = id+instance Query L.ByteString where readQuery = fmap L.fromStrict+instance Query String       where readQuery = fmap S.unpack++-- | allow no parameter. but check parameter type.+instance Query a => Query (Maybe a) where+    readQuery (Just a) = Just `fmap` readQuery (Just a)+    readQuery Nothing  = Just Nothing++-- | always success. for exists check.+instance Query () where+    readQuery _ = Just ()++pInt :: Proxy Int+pInt = Proxy++pInt8 :: Proxy Int8+pInt8 = Proxy+pInt16 :: Proxy Int16+pInt16 = Proxy+pInt32 :: Proxy Int32+pInt32 = Proxy+pInt64 :: Proxy Int64+pInt64 = Proxy+pInteger :: Proxy Integer+pInteger = Proxy++pWord :: Proxy Word+pWord = Proxy+pWord8 :: Proxy Word8+pWord8 = Proxy+pWord32 :: Proxy Word32+pWord32 = Proxy+pWord64 :: Proxy Word64+pWord64 = Proxy++pDouble :: Proxy Double+pDouble = Proxy+pFloat :: Proxy Float+pFloat = Proxy++pText :: Proxy T.Text+pText = Proxy+pLazyText :: Proxy TL.Text+pLazyText = Proxy+pByteString :: Proxy S.ByteString+pByteString = Proxy+pLazyByteString :: Proxy L.ByteString+pLazyByteString = Proxy+pString :: Proxy String+pString = Proxy++pVoid :: Proxy ()+pVoid = Proxy++pMaybe :: Proxy a -> Proxy (Maybe a)+pMaybe _ = Proxy

@@ -2,7 +2,9 @@     (       module Control.Monad.Apiary     , module Control.Monad.Apiary.Action-    , module Web.Apiary.TH+    , module Control.Monad.Apiary.Filter+    , module Data.Apiary.Param+    -- * reexports     -- | MonadIO     , module Control.Monad.Trans     -- | MonadPlus(..), msum, mfilter, guard@@ -11,8 +13,8 @@  import Control.Monad.Apiary import Control.Monad.Apiary.Action-import Web.Apiary.TH+import Data.Apiary.Param  import Control.Monad.Trans(MonadIO(..)) import Control.Monad (MonadPlus(..), msum, mfilter, guard)-+import Control.Monad.Apiary.Filter

@@ -1,5 +0,0 @@-module Web.Apiary.TH-    ( capture-    ) where--import Web.Apiary.TH.Internal

@@ -1,39 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-module Web.Apiary.TH.Internal where--import Language.Haskell.TH-import Language.Haskell.TH.Quote-import Control.Monad.Apiary.Filter.Capture hiding(capture, capture')-import qualified Control.Monad.Apiary.Filter.Capture as Capture-import Data.Apiary.SList-import qualified Data.Text as T--preCap :: String -> [String]-preCap ""  = []-preCap "/" = []-preCap ('/':p) = splitPath p-preCap p       = splitPath p--splitPath :: String -> [String]-splitPath = map T.unpack . T.splitOn "/" . T.pack--mkCap :: [String] -> ExpQ-mkCap [] = [|SNil|]-mkCap ((':':tyStr):as) = do-    -- ty <- lookupTypeName tyStr >>= maybe (fail "") return-    let ty = mkName tyStr-    [|(Fetch :: Fetch $(conT ty)) ::: $(mkCap as) |]-mkCap (eq:as) = do-    [|(Equal $(stringE eq)) ::: $(mkCap as) |]--applyCapture :: ExpQ -> ExpQ-applyCapture e = [|Capture.capture $e|]--capture :: QuasiQuoter-capture = QuasiQuoter -    { quoteExp = applyCapture . mkCap . preCap-    , quotePat  = \_ -> error "No quotePat."-    , quoteType = \_ -> error "No quoteType."-    , quoteDec  = \_ -> error "No quoteDec."-    }

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}  import Test.Framework import Test.Framework.Providers.HUnit@@ -28,6 +29,7 @@ getNeko = setPath defaultRequest "/neko"  --------------------------------------------------------------------------------+ assertPlain200 :: L.ByteString -> Application -> Request -> IO () assertPlain200 body app req = flip runSession app $ do     res <- request req@@ -47,7 +49,7 @@     res <- request req     assertStatus 404 res     assertContentType "text/plain" res-    assertBody "404 Page Notfound." res+    assertBody "404 Page Notfound.\n" res  -------------------------------------------------------------------------------- @@ -111,6 +113,10 @@     ]  --------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+  main :: IO () main = defaultMain