apiary 0.10.0 → 0.11.0

raw patch · 9 files changed

+56/−67 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• apiary.cabal +2/−2
• src/Control/Monad/Apiary/Action/Internal.hs +15/−8
• src/Control/Monad/Apiary/Filter.hs +3/−0
• src/Control/Monad/Apiary/Filter/Internal.hs +2/−0
• src/Control/Monad/Apiary/Filter/Internal/Capture.hs +21/−42
• src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +4/−8
• src/Control/Monad/Apiary/Filter/Internal/Strategy.hs +4/−4
• src/Data/Apiary/Param.hs +2/−0
• test/main.hs +3/−3

@@ -1,5 +1,5 @@ name:                apiary-version:             0.10.0+version:             0.11.0 synopsis:            Simple web framework inspired by scotty. description:   Simple web framework inspired by scotty.@@ -61,7 +61,6 @@                        Control.Monad.Apiary                        Control.Monad.Apiary.Filter                        Control.Monad.Apiary.Filter.Internal-                       Control.Monad.Apiary.Filter.Internal.Capture                        Control.Monad.Apiary.Filter.Internal.Strategy                        Control.Monad.Apiary.Action @@ -70,6 +69,7 @@    other-modules:       Control.Monad.Apiary.Internal                        Control.Monad.Apiary.Action.Internal+                       Control.Monad.Apiary.Filter.Internal.Capture                        Control.Monad.Apiary.Filter.Internal.Capture.TH                        Web.Apiary.TH   other-extensions:    KindSignatures

@@ -66,14 +66,16 @@         , actionStatus   :: Status         , actionHeaders  :: ResponseHeaders         , actionReqBody  :: Maybe ([Param], [File L.ByteString])+        , actionPathInfo :: [T.Text]         } -initialState :: ApiaryConfig -> ActionState-initialState conf = ActionState+initialState :: ApiaryConfig -> Request -> ActionState+initialState conf req = ActionState     { actionResponse = responseLBS (defaultStatus conf) (defaultHeader conf) ""     , actionStatus   = defaultStatus conf     , actionHeaders  = defaultHeader conf     , actionReqBody  = Nothing+    , actionPathInfo = pathInfo req     }  #ifndef WAI3@@ -161,16 +163,18 @@ execActionT :: ApiaryConfig -> ActionT IO () -> Application  #ifdef WAI3-execActionT config m request send = runActionT m config request (initialState config) >>= \case+execActionT config m request send = +#else+execActionT config m request = let send = return in+#endif+    runActionT m config request (initialState config request) >>= \case+#ifdef WAI3         Pass           -> notFound config request send-        Stop s         -> send s-        Continue (_,r) -> send $ actionResponse r #else-execActionT config m request = runActionT m config request (initialState config) >>= \case         Pass           -> notFound config request-        Stop s         -> return s-        Continue (_,r) -> return $ actionResponse r #endif+        Stop s         -> send s+        Continue (_,r) -> send $ actionResponse r  instance (Monad m, Functor m) => Alternative (ActionT m) where     empty = mzero@@ -233,6 +237,9 @@  modifyState :: Monad m => (ActionState -> ActionState) -> ActionT m () modifyState f = ActionT $ \_ _ s c -> c () (f s)++getState :: ActionT m ActionState+getState = ActionT $ \_ _ s c -> c s s  -- | get all request headers. since 0.6.0.0. getHeaders :: Monad m => ActionT m RequestHeaders

@@ -17,6 +17,8 @@     -- ** path matcher     , root     , capture+    , Capture.path+    , Capture.fetch      -- ** query matcher     , query@@ -58,6 +60,7 @@ import Control.Monad.Apiary.Filter.Internal import qualified Control.Monad.Apiary.Filter.Internal.Strategy as Strategy import Control.Monad.Apiary.Filter.Internal.Strategy (pFirst, pOne, pOption, pCheck, pMany, pSome)+import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture import Control.Monad.Apiary.Filter.Internal.Capture.TH import Control.Monad.Apiary.Internal 

@@ -24,3 +24,5 @@ function_ :: (Functor n, Monad n) => (Request -> Bool)            -> ApiaryT c n m b -> ApiaryT c n m b function_ f = function $ \c r -> if f r then Just c else Nothing++

@@ -9,57 +9,36 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE LambdaCase #-}  module Control.Monad.Apiary.Filter.Internal.Capture where -import Network.Wai- import Control.Applicative+import Control.Monad import qualified Data.Text as T import Data.Apiary.Param import Data.Apiary.SList-import Data.Proxy +import Control.Monad.Apiary.Action.Internal 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+-- | check first path and drill down. since v0.11.0.+path :: (Functor n, Monad n) +     => T.Text -> ApiaryT c n m a -> ApiaryT c n m a+path p = focus $ \l -> path' >> return l+  where+    path' = liftM actionPathInfo getState >>= \case+        c:_ | c == p -> modifyState (\s -> s {actionPathInfo = tail $ actionPathInfo s})+        _            -> empty --- | 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 :: (Functor n, Monad n) => Capture as => SList as -        -> ApiaryT (CaptureResult xs as) n m b -> ApiaryT xs n m b-capture cap = function $ \bf req -> capture' cap (pathInfo req) bf+-- | get first path and drill down. since v0.11.0.+fetch :: (Path a, Functor n, Monad n)+      => proxy a -> ApiaryT (Snoc as a) n m b -> ApiaryT as n m b+fetch p = focus $ \l -> liftM actionPathInfo getState >>= \case+    []  -> empty+    c:_ -> case readPathAs p c of+        Nothing -> empty+        Just r  -> do+            modifyState (\s -> s { actionPathInfo = tail $ actionPathInfo s})+            return (sSnoc l r)

@@ -5,7 +5,6 @@ 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 @@ -19,16 +18,13 @@ splitPath = map T.unpack . T.splitOn "/" . T.pack  mkCap :: [String] -> ExpQ-mkCap [] = [|SNil|]+mkCap [] = [|id|] mkCap ((':':tyStr):as) = do     -- ty <- lookupTypeName tyStr >>= maybe (fail "") return     let ty = mkName tyStr-    [|(Proxy :: Capture.Fetch $(conT ty)) ::: $(mkCap as) |]+    [|Capture.fetch (Proxy :: Proxy $(conT ty)) . $(mkCap as) |] mkCap (eq:as) = do-    [|(Capture.Equal $(stringE eq)) ::: $(mkCap as) |]--applyCapture :: ExpQ -> ExpQ-applyCapture e = [|Capture.capture $e|]+    [|(Capture.path $(stringE eq)) . $(mkCap as) |]  -- | capture QuasiQuoter. since 0.1.0.0. --@@ -42,7 +38,7 @@ -- capture :: QuasiQuoter capture = QuasiQuoter -    { quoteExp = applyCapture . mkCap . preCap+    { quoteExp = mkCap . preCap     , quotePat  = \_ -> error "No quotePat."     , quoteType = \_ -> error "No quoteType."     , quoteDec  = \_ -> error "No quoteDec."

@@ -19,12 +19,12 @@   type SNext w (as :: [*]) a  :: [*]   readStrategy :: (v -> Maybe a)                -> ((k,v) -> Bool)-               -> Proxy (w a)+               -> 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 :: (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.@@ -97,10 +97,10 @@                [] -> Nothing                as -> Just $ sSnoc l as -reflectLimit :: Reifies n Int => Proxy (LimitSome n a) -> Int+reflectLimit :: Reifies n Int => proxy (LimitSome n a) -> Int reflectLimit p = reflect $ asTyInt p   where-    asTyInt :: Proxy (LimitSome u a) -> Proxy u+    asTyInt :: proxy (LimitSome u a) -> Proxy u     asTyInt _ = Proxy  -- | type check ( [0,) params to No argument ) since 0.5.0.0.

@@ -32,6 +32,8 @@     where       jsFalse = ["false", "0", "-0", "", "null", "undefined", "NaN"] +readPathAs :: Path a => proxy a -> T.Text -> Maybe a+readPathAs _ t = readPath t  class Path a where   readPath :: T.Text -> Maybe a

@@ -14,9 +14,9 @@  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))+    let (meth, other) = break (== ' ') str+        (p,  version) = break (== ' ') (tail other)+    in testCase str $ f (setPath (setVersion version $ (defaultRequest { requestMethod = S.pack meth })) (S.pack p))   where     setVersion [] r = r     setVersion v r | v == " HTTP/1.1" = r { Network.Wai.httpVersion = HTTP.http11 }