apiary 0.5.1.0 → 0.6.0.0

raw patch · 12 files changed

+323/−269 lines, 12 filesdep +reflectionPVP ok

version bump matches the API change (PVP)

Dependencies added: reflection

API changes (from Hackage documentation)

Files

• apiary.cabal +4/−3
• src/Control/Monad/Apiary.hs +1/−1
• src/Control/Monad/Apiary/Action.hs +1/−2
• src/Control/Monad/Apiary/Action/Internal.hs +15/−18
• src/Control/Monad/Apiary/Filter.hs +75/−78
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +10/−0
• src/Control/Monad/Apiary/Filter/Internal/Query.hs +0/−149
• src/Control/Monad/Apiary/Filter/Internal/Strategy.hs +141/−0
• src/Control/Monad/Apiary/Internal.hs +1/−17
• src/Data/Apiary/Param.hs +21/−1
• src/Web/Apiary.hs +2/−0
• src/Web/Apiary/TH.hs +52/−0

@@ -1,6 +1,5 @@ name:                apiary-version:             0.5.1.0-x-revision:          1+version:             0.6.0.0 synopsis:            Simple web framework inspired by scotty. description:   Simple web framework inspired by scotty.@@ -58,7 +57,7 @@                        Control.Monad.Apiary.Filter                        Control.Monad.Apiary.Filter.Internal                        Control.Monad.Apiary.Filter.Internal.Capture-                       Control.Monad.Apiary.Filter.Internal.Query+                       Control.Monad.Apiary.Filter.Internal.Strategy                        Control.Monad.Apiary.Action                         Data.Apiary.SList@@ -67,6 +66,7 @@   other-modules:       Control.Monad.Apiary.Internal                        Control.Monad.Apiary.Action.Internal                        Control.Monad.Apiary.Filter.Internal.Capture.TH+                       Web.Apiary.TH   other-extensions:    KindSignatures                      , DataKinds                      , TypeOperators@@ -89,6 +89,7 @@                      , monad-logger       >=0.3 && <0.4                      , 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

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

@@ -7,8 +7,7 @@      -- ** getter     , getRequest-    , getQuery, getQuery'-    , getRequestHeader, getRequestHeader'+    , getHeaders      -- ** setter     , status

@@ -181,6 +181,7 @@ stopWith :: Monad m => Response -> ActionT m a stopWith a = ActionT $ \_ _ _ _ -> return $ Stop a +-- | get raw request. since 0.1.0.0. getRequest :: Monad m => ActionT m Request getRequest = ActionT $ \_ r s c -> c r s @@ -190,36 +191,28 @@ modifyState :: Monad m => (ActionState -> ActionState) -> ActionT m () modifyState f = ActionT $ \_ _ s c -> c () (f s) --- | when request header is not found, mzero(pass next handler).-getRequestHeader' :: Monad m => HeaderName -> ActionT m S.ByteString-getRequestHeader' h = getRequestHeader h >>= maybe mzero return--getRequestHeader :: Monad m => HeaderName -> ActionT m (Maybe S.ByteString)-getRequestHeader h = (lookup h . requestHeaders) `liftM` getRequest---- | when query parameter is not found, mzero(pass next handler).-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." #-}+-- | get all request headers. since 0.6.0.0.+getHeaders :: Monad m => ActionT m RequestHeaders+getHeaders = requestHeaders `liftM` getRequest +-- | set status code. since 0.1.0.0. status :: Monad m => Status -> ActionT m () status st = modifyState (\s -> s { actionStatus = st } ) +-- | modify response header. since 0.1.0.0. modifyHeader :: Monad m => (ResponseHeaders -> ResponseHeaders) -> ActionT m () modifyHeader f = modifyState (\s -> s {actionHeaders = f $ actionHeaders s } ) +-- | add response header. since 0.1.0.0. addHeader :: Monad m => HeaderName -> S.ByteString -> ActionT m () addHeader h v = modifyHeader ((h,v):) +-- | set response headers. since 0.1.0.0. setHeaders :: Monad m => ResponseHeaders -> ActionT m () setHeaders hs = modifyHeader (const hs) +-- | set content-type header.+-- if content-type header already exists, replace it. since 0.1.0.0. contentType :: Monad m => S.ByteString -> ActionT m () contentType c = modifyHeader     (\h -> ("Content-Type", c) : filter (("Content-Type" /=) . fst) h)@@ -252,21 +245,25 @@ redirectTemporary   :: Monad m => S.ByteString -> ActionT m a redirectTemporary   = redirect temporaryRedirect307 --- | set body to file content and detect Content-Type by extension.+-- | set response body file content and detect Content-Type by extension. since 0.1.0.0. file :: Monad m => FilePath -> Maybe FilePart -> ActionT m () file f p = do     mime <- mimeType <$> getConfig     contentType (mime f)     file' f p +-- | set response body file content, without set Content-Type. since 0.1.0.0. file' :: Monad m => FilePath -> Maybe FilePart -> ActionT m () file' f p = modifyState (\s -> s { actionBody = File f p } ) +-- | set response body builder. since 0.1.0.0. builder :: Monad m => Builder -> ActionT m () builder b = modifyState (\s -> s { actionBody = Builder b } ) +-- | set response body lazy bytestring. since 0.1.0.0. 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 } )

@@ -2,6 +2,9 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}  module Control.Monad.Apiary.Filter (     -- * filters@@ -16,24 +19,26 @@      -- ** query matcher     , query-    , pFirst, pOne, pOption, pCheck, pMany, pSome     -- *** specified operators     , (=:), (=!:), (=?:), (?:), (=*:), (=+:)     , hasQuery +    -- ** header matcher+    , hasHeader+    , eqHeader+    , headers+    , header+    , header'      -- ** other     , ssl          -- * Reexport-    -- StdMethod(..)+    -- | StdMethod(..)     , module Network.HTTP.Types-    -- * deprecated-    , queryAll,        queryAll'-    , querySome,       querySome'-    , queryFirst,      queryFirst'-    , queryMany,       queryMany'-    , maybeQueryFirst, maybeQueryFirst'+    -- | Strategy Proxies+    , module Control.Monad.Apiary.Filter.Internal.Strategy+     ) where  import Control.Monad@@ -41,18 +46,28 @@ 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.Reflection  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 qualified Control.Monad.Apiary.Filter.Internal.Strategy as Strategy+import Control.Monad.Apiary.Filter.Internal.Strategy (pFirst, pOne, pOption, pCheck, pMany, pSome) import Control.Monad.Apiary.Filter.Internal.Capture.TH import Control.Monad.Apiary.Internal +-- | filter by HTTP method. since 0.1.0.0.+method :: Monad m => HT.Method -> ApiaryT c m a -> ApiaryT c m a+method m = function_ ((m ==) . requestMethod)++-- | filter by HTTP method using StdMethod. since 0.1.0.0.+stdMethod :: Monad m => StdMethod -> ApiaryT c m a -> ApiaryT c m a+stdMethod = method . HT.renderStdMethod++-- | filter by ssl accessed. since 0.1.0.0. ssl :: Monad m => ApiaryT c m a -> ApiaryT c m a ssl = function_ isSecure @@ -72,18 +87,33 @@ 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 +-- | 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.Strategy w, Monad m)+      => S.ByteString+      -> Proxy (w a)+      -> ApiaryT (Strategy.SNext w as a) m b+      -> ApiaryT as m b+query k p = function $ \l r -> Strategy.readStrategy readQuery ((k ==) . fst) p (queryString r) l+ -- | get first matched paramerer. since 0.5.0.0. -- -- @@@ -151,74 +181,41 @@ -- @ -- hasQuery :: Monad m => S.ByteString -> ApiaryT c m a -> ApiaryT c m a-hasQuery q = query q (Proxy :: Proxy (Check ()))+hasQuery q = query q (Proxy :: Proxy (Strategy.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-          -> ApiaryT as m b-queryMany q = function' $ Just . map snd . filter ((q ==) . fst) . queryString---- | filter [1,) parameters by query parameter allows empty value. since 0.4.3.0.-querySome :: Monad m => S.ByteString-          -> ApiaryT (Snoc as [Maybe S.ByteString]) m b-          -> ApiaryT as m b-querySome q = function' $ \r -> case map snd . filter ((q ==) . fst) $ queryString r of-    [] -> Nothing-    as -> Just as+-- | check whether to exists specified header or not. since 0.6.0.0.+hasHeader :: Monad m => HT.HeaderName+          -> ApiaryT as m b -> ApiaryT as m b+hasHeader n = header' pCheck ((n ==) . fst) --- | filter by query parameter. since 0.4.0.0.-queryAll :: Monad m => S.ByteString-         -> ApiaryT (Snoc as [Maybe S.ByteString]) m b -- ^ Nothing == no value paramator.+-- | check whether to exists specified valued header or not. since 0.6.0.0.+eqHeader :: Monad m => HT.HeaderName +         -> S.ByteString  -- ^ header value          -> ApiaryT as m b-queryAll = querySome---- | get [0,) parameters by query parameter not allows empty value. since 0.4.3.0.-queryMany' :: Monad m => S.ByteString-           -> ApiaryT (Snoc as [S.ByteString]) m b -           -> ApiaryT as m b-queryMany' q = function' $ Just . mapMaybe snd . filter ((q ==) . fst) . queryString---- | filter [1,) parameters by query parameter not allows empty value. since 0.4.3.0.-querySome' :: Monad m => S.ByteString-           -> ApiaryT (Snoc as [S.ByteString]) m b -           -> ApiaryT as m b-querySome' q = function' $ \r -> case mapMaybe snd . filter ((q ==) . fst) $ queryString r of-    [] -> Nothing-    as -> Just as---- | filter by query parameter. since 0.4.0.0.-queryAll' :: Monad m => S.ByteString-          -> ApiaryT (Snoc as [S.ByteString]) m b -          -> ApiaryT as m b-queryAll' = querySome'+         -> ApiaryT as m b+eqHeader k v = header' pCheck (\(k',v') -> k == k' && v == v') --- | get first query parameter allow empty value. since 0.4.3.0,-maybeQueryFirst :: Monad m => S.ByteString-                -> ApiaryT (Snoc as (Maybe (Maybe S.ByteString))) m b-                -> ApiaryT as m b-maybeQueryFirst q = function' (Just . lookup q . queryString)+-- | filter by header and get first. since 0.6.0.0.+header :: Monad m => HT.HeaderName+       -> ApiaryT (Snoc as S.ByteString) m b -> ApiaryT as m b+header n = header' pFirst ((n ==) . fst) --- | filter by query parameter. allow empty value. since 0.4.0.0.-queryFirst :: Monad m => S.ByteString-           -> ApiaryT (Snoc as (Maybe S.ByteString)) m b-           -> ApiaryT as m b-queryFirst q = function' (lookup q . queryString)+-- | filter by headers up to 100 entries. since 0.6.0.0.+headers :: Monad m => HT.HeaderName+        -> ApiaryT (Snoc as [S.ByteString]) m b -> ApiaryT as m b+headers n = header' limit100 ((n ==) . fst)+  where+    limit100 :: Proxy x -> Proxy (Strategy.LimitSome $(int 100) x)+    limit100 _ = Proxy --- | get first query parameter not allow empty value. since 0.4.3.0,-maybeQueryFirst' :: Monad m => S.ByteString-                 -> ApiaryT (Snoc as (Maybe S.ByteString)) m b-                 -> ApiaryT as m b-maybeQueryFirst' q = function' $ Just . listToMaybe . mapMaybe snd . filter ((q ==) . fst) . queryString+-- | low level header filter. since 0.6.0.0.+header' :: (Strategy.Strategy w, Monad m)+        => (forall x. Proxy x -> Proxy (w x))+        -> (HT.Header -> Bool)+        -> ApiaryT (Strategy.SNext w as S.ByteString) m b+        -> ApiaryT as m b+header' pf kf = function $ \l r ->+    Strategy.readStrategy Just kf (pf pByteString) (requestHeaders r) l --- | filter by query parameter. not allow empty value. since 0.4.0.0.-queryFirst' :: Monad m => S.ByteString-            -> ApiaryT (Snoc as S.ByteString) m b-            -> ApiaryT as m b-queryFirst' q = function' $ listToMaybe . mapMaybe snd . filter ((q ==) . fst) . queryString

@@ -30,6 +30,16 @@ applyCapture :: ExpQ -> ExpQ applyCapture e = [|Capture.capture $e|] +-- | capture QuasiQuoter. since 0.1.0.0.+--+-- example:+--+-- @+-- [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 :: QuasiQuoter capture = QuasiQuoter      { quoteExp = applyCapture . mkCap . preCap

@@ -1,149 +0,0 @@-{-# 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---- | 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

@@ -0,0 +1,141 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Control.Monad.Apiary.Filter.Internal.Strategy where++import Data.Apiary.SList++import Data.Maybe+import Data.Proxy+import Data.Reflection++class Strategy (w :: * -> *) where+  type SNext w (as :: [*]) a  :: [*]+  readStrategy :: (v -> Maybe a)+               -> ((k,v) -> Bool)+               -> Proxy (w a)+               -> [(k, v)]+               -> SList as +               -> Maybe (SList (SNext w as a))++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+    type SNext Option as a = Snoc as (Maybe a)+    readStrategy rf k p q l =+        let rs = getQuery rf p k q+        in if any isNothing rs+           then Nothing+           else Just . sSnoc l $ case catMaybes rs of+               []  -> Nothing+               a:_ -> Just a++-- | 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 rf k p q l =+        let rs = getQuery rf 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 rf k p q l =+        let rs = getQuery rf 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 rf k p q l =+        let rs = getQuery rf 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 rf k p q l =+        let rs = getQuery rf p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               [] -> Nothing+               as -> Just $ sSnoc l as++-- | get parameters with upper limit ( [1,n] to [Type]) since 0.6.0.0.+data LimitSome u a+instance (Reifies u Int) => Strategy (LimitSome u) where+    type SNext (LimitSome u) as a = Snoc as [a]+    readStrategy rf k p q l =+        let rs = take (reflectLimit p) $ getQuery rf p k q+        in if any isNothing rs+           then Nothing+           else case catMaybes rs of+               [] -> Nothing+               as -> Just $ sSnoc l as++reflectLimit :: Reifies n Int => Proxy (LimitSome n a) -> Int+reflectLimit p = reflect $ asTyInt p+  where+    asTyInt :: Proxy (LimitSome u a) -> Proxy u+    asTyInt _ = Proxy++-- | 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 rf k p q l =+        let rs = getQuery rf p k q+        in if any isNothing rs+           then Nothing+           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

@@ -78,7 +78,7 @@         unApiaryT m run (\r -> grd r >>= \c -> g r c) cfg cont  action :: Monad m => Fn c (ActionT m ()) -> ApiaryT c m ()-action = actionWithPreAction_ (return ())+action = actionWithPreAction (const $ return ())  -- | execute action before main action. since v0.4.2.0 actionWithPreAction :: Monad m => (SList xs -> ActionT IO a)@@ -87,19 +87,3 @@     tr  <- getRunner     grd <- getGuard     addRoute $ filterToActionT grd >>= \c -> (pa c) >> tr (apply a c)----- | execute no argument action before main action. since v0.4.2.0-actionWithPreAction_ :: Monad m => ActionT IO a-                     -> Fn c (ActionT m ()) -> ApiaryT c m ()-actionWithPreAction_ pa a = do-    tr  <- getRunner-    grd <- getGuard-    addRoute $ filterToActionT grd >>= \c -> pa >> tr (apply a c)--{-# DEPRECATED action_ "use action method." #-}-action_ :: Monad m => ActionT m () -> ApiaryT c m ()-action_ a = do-    tr <- getRunner-    grd <- getGuard-    addRoute $ filterToActionT grd >> tr a

@@ -1,4 +1,5 @@ {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TypeFamilies #-}@@ -19,7 +20,14 @@ import Data.Int import Data.Word import Data.Proxy+import Data.String(IsString) +jsToBool :: (IsString a, Eq a) => a -> Bool+jsToBool = flip notElem jsFalse+    where+      jsFalse = ["false", "0", "-0", "", "null", "undefined", "NaN"]++ class Path a where   readPath :: T.Text -> Maybe a @@ -27,6 +35,10 @@     readPath    s | T.null s  = Nothing                   | otherwise = Just $ T.head s +-- | javascript boolean.+-- when \"false\", \"0\", \"-0\", \"\", \"null\", \"undefined\", \"NaN\" then False, else True. since 0.6.0.0.+instance Path Bool where readPath = Just . jsToBool+ instance Path Int     where readPath    = readMaybe . T.unpack instance Path Int8    where readPath    = readMaybe . T.unpack instance Path Int16   where readPath    = readMaybe . T.unpack@@ -54,6 +66,10 @@ class Query a where     readQuery :: Maybe S.ByteString -> Maybe a +-- | javascript boolean.+-- when \"false\", \"0\", \"-0\", \"\", \"null\", \"undefined\", \"NaN\" then False, else True. since 0.6.0.0.+instance Query Bool where readQuery = fmap jsToBool+ 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)@@ -85,9 +101,11 @@ instance Query () where     readQuery _ = Just () +pBool :: Proxy Bool+pBool = Proxy+ pInt :: Proxy Int pInt = Proxy- pInt8 :: Proxy Int8 pInt8 = Proxy pInt16 :: Proxy Int16@@ -103,6 +121,8 @@ pWord = Proxy pWord8 :: Proxy Word8 pWord8 = Proxy+pWord16 :: Proxy Word16+pWord16 = Proxy pWord32 :: Proxy Word32 pWord32 = Proxy pWord64 :: Proxy Word64

@@ -4,6 +4,7 @@     , module Control.Monad.Apiary.Action     , module Control.Monad.Apiary.Filter     , module Data.Apiary.Param+    , act     -- * reexports     -- | MonadIO     , module Control.Monad.Trans@@ -18,3 +19,4 @@ import Control.Monad.Trans(MonadIO(..)) import Control.Monad (MonadPlus(..), msum, mfilter, guard) import Control.Monad.Apiary.Filter+import Web.Apiary.TH

@@ -0,0 +1,52 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+module Web.Apiary.TH where++import Control.Monad.Apiary+import Control.Monad.Apiary.Action+import Network.HTTP.Types.Status+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as S+import Network.Mime++numToCode :: Int -> ExpQ+numToCode = \case+    100 -> varE 'status100+    101 -> varE 'status101+    200 -> varE 'status200+    201 -> varE 'status201+    n   -> fail $ "unknown HTTP status code:" ++ show n++-- | shortcut action. since 0.6.0.0.+--+-- @+-- [act|200 .html|] == [act|200 text/html|] ==+-- action $ \\arguments -> do+--     status 200+--     contentType "text/html"+-- @+act :: QuasiQuoter+act = QuasiQuoter +    { quoteExp  = act'+    , quotePat  = \_ -> fail "act QQ only Exp."+    , quoteType = \_ -> fail "act QQ only Exp."+    , quoteDec  = \_ -> fail "act QQ only Exp."+    }++parseAct :: String -> (Int, String)+parseAct s =+    let (code, ct) = T.break (== ' ') . T.strip $ T.pack s+        mime       = case T.strip ct of+            t | T.head t == '.' -> defaultMimeLookup t+              | otherwise       -> S.pack $ T.unpack t+    in (read $ T.unpack code, S.unpack mime)++act' :: String -> ExpQ+act' s = +    let (code, mime) = parseAct s+         in [| actionWithPreAction (\_ -> do +             status $(numToCode code)+             contentType $(stringE mime)+             )|]