packages feed

servant-matrix-param 0.1.0.1 → 0.2

raw patch · 8 files changed

+287/−43 lines, 8 filesdep +aesondep +bytestringdep +containers

Dependencies added: aeson, bytestring, containers, http-types, servant-server, string-conversions, text, transformers, wai, wai-extra

Files

servant-matrix-param.cabal view
@@ -1,5 +1,5 @@ name:           servant-matrix-param-version:        0.1.0.1+version:        0.2 synopsis:       Matrix parameter combinator for servant description:    Matrix parameter combinator for servant category:       Web@@ -19,6 +19,11 @@   manual: True   default: False +flag with-servant-server+  description: support for servant-server+  manual: True+  default: False+ library   default-language: Haskell2010   ghc-options: -Wall@@ -34,6 +39,15 @@         servant-aeson-specs == 0.2.* || == 0.3.* || == 0.4.*     exposed-modules:         Servant.MatrixParam.AesonSpecs+  if flag(with-servant-server)+    build-depends:+      servant-server == 0.5,+      containers,+      string-conversions,+      text+    exposed-modules:+      Servant.MatrixParam.Server+      Servant.MatrixParam.Server.Internal  test-suite spec   default-language: Haskell2010@@ -48,8 +62,18 @@     , servant == 0.5     , servant-aeson-specs     , servant-matrix-param+    , servant-server+    , wai+    , containers+    , text+    , wai-extra+    , http-types+    , bytestring+    , transformers+    , aeson   other-modules:       Servant.MatrixParam.AesonSpecsSpec+      Servant.MatrixParam.ServerSpec       Servant.MatrixParamSpec  test-suite doctest
src/Servant/MatrixParam.hs view
@@ -1,51 +1,27 @@-{-# LANGUAGE DataKinds          #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PolyKinds          #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-} -module Servant.MatrixParam (MatrixFlag, MatrixParam, MatrixParams) where+module Servant.MatrixParam (+  WithMatrixParams,+  MatrixParam,+) where  import           Data.Typeable (Typeable) import           GHC.TypeLits  (Symbol)--- | Lookup the value associated to the @sym@ matrix string parameter--- and try to extract it as a value of type @a@.------ Example:------ >>> -- /books;author=<author name>--- >>> type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book]-data MatrixParam (sym :: Symbol) a-    deriving (Typeable) --- | Lookup the values associated to the @sym@ matrix string parameter--- and try to extract it as a value of type @[a]@. This is typically--- meant to support matrix string parameters of the form--- @param[]=val1;param[]=val2@ and so on. Note that servant doesn't actually--- require the @[]@s and will fetch the values just fine with--- @param=val1;param=val2@, too.------ Example:------ >>> -- /books;authors[]=<author1>;authors[]=<author2>;...--- >>> type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book]-data MatrixParams (sym :: Symbol) a+data WithMatrixParams (path :: Symbol) (paramSpecs :: [*])     deriving (Typeable) --- | Lookup a potentially value-less matrix string parameter--- with boolean semantics. If the param @sym@ is there without any value,--- or if it's there with value "true" or "1", it's interpreted as 'True'.--- Otherwise, it's interpreted as 'False'.+-- | Expresses matrix parameters for path segments in APIs, e.g. ----- Example:+-- @/books;author=<author name>@ ----- >>> -- /books;published--- >>> type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]-data MatrixFlag (sym :: Symbol)+-- would be represented as:+--+-- >>> import Servant+-- >>>+-- >>> type MyApi = "books" :> MatrixParam "author" String :> Get '[JSON] [String]+data MatrixParam (key :: Symbol) a     deriving (Typeable)----- $setup--- >>> import Servant.API--- >>> import Data.Aeson--- >>> import Data.Text--- >>> data Book--- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/MatrixParam/AesonSpecs.hs view
@@ -12,5 +12,5 @@  import           Servant.MatrixParam -instance HasGenericSpecs api => HasGenericSpecs (MatrixParam name a :> api) where+instance HasGenericSpecs api => HasGenericSpecs (WithMatrixParams path params :> api) where   collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)
+ src/Servant/MatrixParam/Server.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | If you use @'MatrixParam' "author" String@ in one of the endpoints for your API,+-- this automatically requires your server-side handler to be a function+-- that takes an argument of type @'Maybe' 'String'@.+--+-- This lets servant worry about looking it up in the query string+-- and turning it into a value of the type you specify, enclosed+-- in 'Maybe', because it may not be there and servant would then+-- hand you 'Nothing'.+--+-- You can control how it'll be converted from 'Text' to your type+-- by simply providing an instance of 'FromHttpApiData' for your type.+--+-- Example:+--+-- >>> import Network.Wai+-- >>> import Servant+-- >>>+-- >>> type Api = WithMatrixParams "books" '[MatrixParam "author" String] :> Get '[JSON] [String]+-- >>> let api = Proxy :: Proxy Api+-- >>>+-- >>> -- serveBooks has type @Maybe String -> ExceptT ServantErr IO [String]@+-- >>> let serveBooks mAuthor = return $ case mAuthor of {Just "alice" -> ["Alice's Diary"]; _ -> []}+-- >>>+-- >>> let app = serve api serveBooks :: Application+--+-- You can also have multiple matrix parameters per path segment.+module Servant.MatrixParam.Server where++import           Prelude hiding (lookup)++import           Data.Map.Strict+import           Data.Proxy+import           Data.String.Conversions+import           Data.Text as T hiding (last)+import           GHC.TypeLits+import           Servant.API+import           Servant.Server+import           Servant.Server.Internal++import           Servant.MatrixParam+import           Servant.MatrixParam.Server.Internal++instance (KnownSymbol path, MatrixParamList params, HasServer api context) =>+  HasServer (WithMatrixParams path params :> api) context where++  type ServerT (WithMatrixParams path params :> api) m =+    AddMatrixParams params (ServerT api m)++  route Proxy context delayed =+    DynamicRouter $ \ first -> case parsePathSegment first of+      Just segment -> if wantedPath == segmentPath segment+        then route apiProxy context $ routeMatrixParams paramsProxy (getSegmentParams segment) delayed+        else LeafRouter $ \ _request respond -> respond $ Fail err404+      Nothing -> LeafRouter $ \ _request respond -> respond $ Fail err400+    where+      apiProxy :: Proxy api+      apiProxy = Proxy++      paramsProxy :: Proxy params+      paramsProxy = Proxy++      wantedPath :: Text+      wantedPath = cs $ symbolVal (Proxy :: Proxy path)++class MatrixParamList (params :: [*]) where+  type AddMatrixParams params a :: *++  routeMatrixParams :: Proxy params -> Map Text Text+    -> Delayed (AddMatrixParams params a) -> Delayed a++instance MatrixParamList '[] where+  type AddMatrixParams '[] a = a++  routeMatrixParams Proxy _ delayed = delayed++instance (KnownSymbol key, FromHttpApiData value, MatrixParamList rest) =>+  MatrixParamList (MatrixParam key value ': rest) where++  type AddMatrixParams (MatrixParam key value ': rest) a =+    Maybe value -> AddMatrixParams rest a++  routeMatrixParams Proxy params delayed =+    routeMatrixParams restProxy params $+    addCapture delayed $ case lookup key params of+      Nothing -> return $ Route Nothing+      Just rawValue -> case parseQueryParam rawValue of+        Right value -> return $ Route $ Just value+        Left _ -> return $ Route Nothing+    where+      key :: Text+      key = cs $ symbolVal (Proxy :: Proxy key)++      restProxy :: Proxy rest+      restProxy = Proxy
+ src/Servant/MatrixParam/Server/Internal.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Servant.MatrixParam.Server.Internal (+  MatrixSegment(..),+  getSegmentParams,+  parsePathSegment,+) where++import           Data.List (foldl')+import           Data.Map.Strict+import           Data.Maybe+import           Data.Text++data MatrixSegment+  = MatrixSegment {+    segmentPath :: Text,+    segmentParams :: Maybe (Map Text Text)+  }+  deriving (Show, Eq)++getSegmentParams :: MatrixSegment -> Map Text Text+getSegmentParams = fromMaybe mempty . segmentParams++parsePathSegment :: Text -> Maybe MatrixSegment+parsePathSegment segment = case splitOn ";" segment of+  [] -> return $ MatrixSegment "" mempty+  [path] -> return $ MatrixSegment path mempty+  [path, ""] -> return $ MatrixSegment path mempty+  (path : pairs) ->+    Just $ MatrixSegment path $+      fmap collectPairs $ mapM parsePair pairs++parsePair :: Text -> Maybe (Text, Maybe Text)+parsePair pair = case splitOn "=" pair of+  [key, value] -> Just (key, Just value)+  [flag] -> Just (flag, Nothing)+  _ -> Nothing++collectPairs :: forall a b . Show b => Ord a => [(a, Maybe b)] -> Map a b+collectPairs =+  Data.List.foldl'+    (\ acc (k, mv) -> maybe acc (\ v -> insert k v acc) mv)+    mempty
test/Doctest.hs view
@@ -4,6 +4,7 @@ main :: IO () main = doctest $   "src/Servant/MatrixParam.hs" :+  "src/Servant/MatrixParam/Server.hs" :   "-isrc" :   "-XDataKinds" :   "-XTypeOperators" :
test/Servant/MatrixParam/AesonSpecsSpec.hs view
@@ -16,7 +16,7 @@   it "has an instance for HasGenericSpecs" $ do     usedTypes matrixParamApi `shouldBe` [boolRep] -matrixParamApi :: Proxy (MatrixParam "foo" String :> Get '[JSON] Bool)+matrixParamApi :: Proxy (WithMatrixParams "path" '[MatrixParam "foo" String] :> Get '[JSON] Bool) matrixParamApi = Proxy  boolRep :: TypeRep
+ test/Servant/MatrixParam/ServerSpec.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Servant.MatrixParam.ServerSpec where++import           Control.Monad.IO.Class+import           Control.Monad.Trans.Except+import           Data.ByteString.Lazy+import           Data.Map.Strict+import           Data.Proxy+import           Data.Text+import           Network.HTTP.Types (ok200)+import           Network.Wai+import           Network.Wai.Test+import           Servant.API+import           Servant.Server+import           Test.Hspec++import           Servant.MatrixParam+import           Servant.MatrixParam.Server ()+import           Servant.MatrixParam.Server.Internal++type Api =+       WithMatrixParams "a" '[MatrixParam "name" String] :> Get '[PlainText] String+  :<|> WithMatrixParams "b" '[MatrixParam "foo" Int, MatrixParam "bar" Int]+         :> Get '[PlainText] String++api :: Proxy Api+api = Proxy++type Handler = ExceptT ServantErr IO++server :: Server Api+server = a :<|> b+  where+    a :: Maybe String -> Handler String+    a p = return $ show p++    b :: Maybe Int -> Maybe Int -> Handler String+    b foo bar = return $ show (foo, bar)++testWithPath :: [Text] -> ByteString -> IO ()+testWithPath segments expected = do+  (flip runSession) (serve api server) $ do+    response <- Network.Wai.Test.request defaultRequest{+      pathInfo = segments+    }+    liftIO $ do+      simpleStatus response `shouldBe` ok200+      simpleBody response `shouldBe` expected++spec :: Spec+spec = do+  describe "Servant.API.MatrixParam" $ do+    it "allows to retrieve simple matrix parameters" $ do+      testWithPath ["a;name=bob"] "Just \"bob\""++    it "allows to omit matrix parameters" $ do+      testWithPath ["a"] "Nothing"++    it "allows multiple keys per segment" $ do+      testWithPath ["b;foo=23;bar=42"] "(Just 23,Just 42)"++    it "allows to overwrite matrix params" $ do+      testWithPath ["a;name=alice;name=bob"] "Just \"bob\""++  describe "parsePathSegment" $ do+    it "parses a path segment with a matrix param" $ do+      parsePathSegment "foo;bar=baz" `shouldBe`+        Just (MatrixSegment "foo" (Just (fromList [("bar", "baz")])))++    it "parses a bare segment" $ do+      parsePathSegment "foo" `shouldBe`+        Just (MatrixSegment "foo" mempty)++    it "parses a segment with multiple matrix params" $ do+      parsePathSegment "foo;bar=baz;huhu=baba" `shouldBe`+        Just (MatrixSegment "foo" (Just (fromList [("bar", "baz"), ("huhu", "baba")])))++    it "parses a segment with multiple values for the same matrix param" $ do+      parsePathSegment "foo;bar=baz;bar=huhu" `shouldBe`+        Just (MatrixSegment "foo" (Just (fromList [("bar", "huhu")])))++    it "parses a segment with semicolon but without params" $ do+      parsePathSegment "foo;" `shouldBe`+        Just (MatrixSegment "foo" mempty)++    it "succeeds for invalid matrix parameters strings" $ do+      parsePathSegment "foo;bar==" `shouldBe`+        Just (MatrixSegment "foo" mempty)++    it "can parse the empty string as value" $ do+      parsePathSegment "foo;bar=" `shouldBe`+        Just (MatrixSegment "foo" (Just (fromList [("bar", "")])))