packages feed

servant-matrix-param 0.3.1 → 0.3.2

raw patch · 7 files changed

+102/−18 lines, 7 files

Files

servant-matrix-param.cabal view
@@ -1,5 +1,5 @@ name:           servant-matrix-param-version:        0.3.1+version:        0.3.2 synopsis:       Matrix parameter combinator for servant description:    Matrix parameter combinator for servant category:       Web
src/Servant/MatrixParam.hs view
@@ -5,6 +5,7 @@  module Servant.MatrixParam (   WithMatrixParams,+  CaptureWithMatrixParams,   MatrixParam,   MatrixFlag, ) where@@ -12,7 +13,12 @@ import           Data.Typeable (Typeable) import           GHC.TypeLits  (Symbol) +-- | A static path followed by one or more matrix parameters. data WithMatrixParams (path :: Symbol) (paramSpecs :: [*])+    deriving (Typeable)++-- | A capture followed by one or more matrix parameters.+data CaptureWithMatrixParams (path :: Symbol) captureType (paramSpecs :: [*])     deriving (Typeable)  -- | Expresses matrix parameters for path segments in APIs, e.g.
src/Servant/MatrixParam/Client/Internal.hs view
@@ -16,42 +16,56 @@ import           Servant.MatrixParam  instance-  ( HasClient (WMP path mat :> api)+  ( HasClient (WMP mat :> api)   , KnownSymbol path   )   => HasClient (WithMatrixParams path mat :> api) where    type Client (WithMatrixParams path mat :> api)-    = Client (WMP path mat :> api)+    = Client (WMP mat :> api)    clientWithRoute Proxy req =-    clientWithRoute (Proxy :: Proxy (WMP path mat :> api))+    clientWithRoute (Proxy :: Proxy (WMP mat :> api))                     req { reqPath = reqPath req ++ "/" ++ path }     where      path = symbolVal (Proxy :: Proxy path) +instance+  ( HasClient (WMP mat :> api)+  , ToHttpApiData captureType+  )+  => HasClient (CaptureWithMatrixParams info captureType mat :> api) where++  type Client (CaptureWithMatrixParams info captureType mat :> api)+    = captureType -> Client (WMP mat :> api)++  clientWithRoute Proxy req = \capture ->+    clientWithRoute (Proxy :: Proxy (WMP mat :> api))+                    req { reqPath = reqPath req ++ "/" ++ T.unpack (toUrlPiece capture) }++ -- This is just a dummy used to keep track of whether we have already processed -- the leading path. If we are in a WMP instance, we have already dealt with -- the leading path, and can just proceed recursively over the matrix params. -- If not, we deal with the leading path, and call the WMP instance. WMP itself -- should not be exported.-data WMP (p :: Symbol) (x :: [*])+data WMP (x :: [*])  instance-  ( HasClient (WMP path rest :> api)+  ( HasClient (WMP rest :> api)   , ToHttpApiData v   , KnownSymbol k-  ) => HasClient (WMP path (MatrixParam k v ': rest) :> api) where+  ) => HasClient (WMP (MatrixParam k v ': rest) :> api) where -  type Client (WMP path (MatrixParam k v ': rest) :> api)-    = Maybe v -> Client (WMP path rest :> api)+  type Client (WMP (MatrixParam k v ': rest) :> api)+    = Maybe v -> Client (WMP rest :> api)    clientWithRoute Proxy req x = case x of     Nothing -> clientWithRoute nextProxy req     Just v  -> clientWithRoute nextProxy       req { reqPath = reqPath req ++ ";" ++ key ++ "=" ++ T.unpack (toQueryParam v) }     where-      nextProxy :: Proxy (WMP path rest :> api)+      nextProxy :: Proxy (WMP rest :> api)       nextProxy = Proxy        key :: String@@ -59,9 +73,9 @@  instance   ( HasClient api-  ) => HasClient (WMP path '[] :> api) where+  ) => HasClient (WMP '[] :> api) where -  type Client (WMP path '[] :> api) = Client api+  type Client (WMP '[] :> api) = Client api    clientWithRoute Proxy req =     clientWithRoute (Proxy :: Proxy api) req
src/Servant/MatrixParam/Server.hs view
@@ -75,6 +75,30 @@       wantedPath :: Text       wantedPath = cs $ symbolVal (Proxy :: Proxy path) +instance (HasServer api context+        , App (Unapped params (ServerT api Handler)) params+        , FromHttpApiData captureType+        , Apped (Unapped params (ServerT api Handler)) params+          ~ (ServerT api Handler)+        , ParseArgs params+        ) =>+  HasServer (CaptureWithMatrixParams path captureType params :> api) context where++  type ServerT (CaptureWithMatrixParams path captureType params :> api) m =+    captureType -> Unapped params (ServerT api m)++  route Proxy context delayed =+    CaptureRouter $+        route (Proxy :: Proxy api)+              context+              (addCapturedMatrices delayed $ \ txt -> case parsePathSegment txt of+                 Nothing -> delayedFail err400+                 Just segment -> case parseUrlPiece (segmentPath segment) of+                   Left _ -> delayedFail err400+                   Right value -> return+                     $ (value, parseArgs $ getSegmentParams segment :: ArgList params)+              )+ addMatrices :: App fn argList => Delayed env fn            -> (captured -> DelayedIO (ArgList argList))            -> Delayed (captured, env) (Apped fn argList)@@ -82,5 +106,21 @@   Delayed     { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt     , serverD   = \ (x, v) a b req -> (`apply` v)  <$> serverD x a b req+    , ..+    }++addCapturedMatrices+  :: ( App restOfFn argList+     , fn ~ (captureType -> restOfFn)+     , Apped restOfFn argList ~ result)+  => Delayed env fn+  -> (captured -> DelayedIO (captureType, ArgList argList))+  -> Delayed (captured, env) result+addCapturedMatrices Delayed{..} new =+  Delayed+    { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt+    , serverD   = \ (x, (capture, matrixParams)) a b req ->+        let appCapture = ($ capture) <$> serverD x a b req+        in (`apply` matrixParams) <$> appCapture     , ..     }
src/Servant/MatrixParam/Server/Internal/ArgList.hs view
@@ -21,7 +21,9 @@ -- An HList that stores the arguments to a function data ArgList a where   NoArgs :: ArgList '[]+  -- A matrix param (always optional)   (:.:)  :: Maybe a -> ArgList as -> ArgList (MatrixParam key a ': as)+  -- A matrix flag   (:?:)  :: Bool -> ArgList as -> ArgList (MatrixFlag key ': as)  type family Unapped (params :: [*]) end where
test/Servant/MatrixParam/ClientSpec.hs view
@@ -47,15 +47,21 @@       cliA Nothing `hasRequestPath` "/a"       cliB Nothing Nothing `hasRequestPath` "/b" +    it "can be combined with captures" $ do+      cliC 5 (Just 3) Nothing `hasRequestPath` "/5;foo=3"++ #if MIN_VERSION_servant_client(0,9,0)     it "generates paths that servant-server understands" $ do       testWithApplication (return $ serve api server) $ \port -> do-        let res = (,) <$> cliA (Just "There is a there there")-                      <*> cliB (Just 1) (Just 2)+        let res = (,,) <$> cliA (Just "There is a there there")+                       <*> cliB (Just 1) (Just 2)+                       <*> cliC 5 (Just 1) (Just 2)+             url = BaseUrl Http "localhost" port ""         mgr' <- newManager defaultManagerSettings         runClientM res (ClientEnv mgr' url)-          `shouldReturn` Right ("There is a there there", "3")+          `shouldReturn` Right ("There is a there there", "3", "8") #endif ------------------------------------------------------------------------------ -- API@@ -65,6 +71,8 @@        WithMatrixParams "a" '[MatrixParam "name" String] :> Get '[JSON] String   :<|> WithMatrixParams "b" '[MatrixParam "foo" Int, MatrixParam "bar" Int]          :> Get '[JSON] String+  :<|> CaptureWithMatrixParams "c" Int '[MatrixParam "foo" Int, MatrixParam "bar" Int]+         :> Get '[JSON] String  api :: Proxy Api api = Proxy@@ -72,10 +80,11 @@  #if MIN_VERSION_servant_client(0,9,0) server :: Server Api-server = e1 :<|> e2+server = e1 :<|> e2 :<|> e3   where     e1 name = return $ fromMaybe "" name     e2 foo bar = return . show $ fromMaybe 0 foo + fromMaybe 0 bar+    e3 int foo bar = return . show $ int + fromMaybe 0 foo + fromMaybe 0 bar #endif  ------------------------------------------------------------------------------@@ -122,8 +131,10 @@ #if MIN_VERSION_servant_client(0,9,0) cliA :: Maybe String -> ClientM String cliB :: Maybe Int -> Maybe Int -> ClientM String+cliC :: Int -> Maybe Int -> Maybe Int -> ClientM String #else cliA :: Maybe String -> Manager -> BaseUrl -> ClientM String cliB :: Maybe Int -> Maybe Int -> Manager -> BaseUrl -> ClientM String+cliC :: Int -> Maybe Int -> Maybe Int -> Manager -> BaseUrl -> ClientM String #endif-cliA :<|> cliB = client api+cliA :<|> cliB :<|> cliC = client api
test/Servant/MatrixParam/ServerSpec.hs view
@@ -26,12 +26,14 @@          :> Get '[PlainText] String   :<|> WithMatrixParams "c" '[MatrixParam "foo" Int, MatrixFlag "baz", MatrixParam "bar" Int]          :> Get '[PlainText] String+  :<|> CaptureWithMatrixParams "d" Int '[MatrixParam "foo" Int, MatrixFlag "baz"]+         :> Get '[PlainText] String  api :: Proxy Api api = Proxy  server :: Server Api-server = a :<|> b :<|> c+server = a :<|> b :<|> c :<|> d   where     a :: Maybe String -> Handler String     a p = return $ show p@@ -43,6 +45,10 @@     c foo baz bar | baz = return $ show (foo, bar)                   | otherwise = return "" +    d :: Int -> Maybe Int -> Bool -> Handler String+    d capture foo baz | baz = return $ show capture+                      | otherwise = return $ show foo+ testWithPath :: [Text] -> ByteString -> IO () testWithPath segments expected = do   (flip runSession) (serve api server) $ do@@ -80,6 +86,11 @@      it "allows to overwrite matrix params" $ do       testWithPath ["a;name=alice;name=bob"] "Just \"bob\""++    context "with capture" $+      it "parses the capture " $ do+        testWithPath ["5;baz"] "5"+        testWithPath ["5;foo=3"] "Just 3"     describe "parsePathSegment" $ do