packages feed

servant-matrix-param 0.2 → 0.3

raw patch · 6 files changed

+94/−54 lines, 6 filesdep +http-api-datadep ~servantdep ~servant-aeson-specsdep ~servant-servernew-uploader

Dependencies added: http-api-data

Dependency ranges changed: servant, servant-aeson-specs, servant-server

Files

servant-matrix-param.cabal view
@@ -1,5 +1,5 @@ name:           servant-matrix-param-version:        0.2+version:        0.3 synopsis:       Matrix parameter combinator for servant description:    Matrix parameter combinator for servant category:       Web@@ -31,23 +31,25 @@       src   build-depends:       base < 5-    , servant == 0.5+    , servant >= 0.7 && < 0.10   exposed-modules:       Servant.MatrixParam   if flag(with-servant-aeson-specs)     build-depends:-        servant-aeson-specs == 0.2.* || == 0.3.* || == 0.4.*+        servant-aeson-specs > 0.2 && < 0.6     exposed-modules:         Servant.MatrixParam.AesonSpecs   if flag(with-servant-server)     build-depends:-      servant-server == 0.5,+      servant-server >= 0.7 && < 0.10,+      http-api-data >= 0.2 && < 0.4,       containers,       string-conversions,       text     exposed-modules:       Servant.MatrixParam.Server       Servant.MatrixParam.Server.Internal+      Servant.MatrixParam.Server.Internal.ArgList  test-suite spec   default-language: Haskell2010@@ -59,7 +61,7 @@   build-depends:       base < 5     , hspec-    , servant == 0.5+    , servant >= 0.7 && < 0.10     , servant-aeson-specs     , servant-matrix-param     , servant-server@@ -85,5 +87,5 @@       test   build-depends:       base < 5-    , servant == 0.5+    , servant >= 0.7 && < 0.10     , doctest
src/Servant/MatrixParam/AesonSpecs.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}@@ -13,4 +14,8 @@ import           Servant.MatrixParam  instance HasGenericSpecs api => HasGenericSpecs (WithMatrixParams path params :> api) where+#if MIN_VERSION_servant_aeson_specs(0,5,0)+  collectRoundtripSpecs settings Proxy = collectRoundtripSpecs settings (Proxy :: Proxy api)+#else   collectRoundtripSpecs Proxy = collectRoundtripSpecs (Proxy :: Proxy api)+#endif
src/Servant/MatrixParam/Server.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RecordWildCards #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -38,7 +39,6 @@  import           Prelude hiding (lookup) -import           Data.Map.Strict import           Data.Proxy import           Data.String.Conversions import           Data.Text as T hiding (last)@@ -49,56 +49,38 @@  import           Servant.MatrixParam import           Servant.MatrixParam.Server.Internal+import           Servant.MatrixParam.Server.Internal.ArgList -instance (KnownSymbol path, MatrixParamList params, HasServer api context) =>+instance (KnownSymbol path, HasServer api context+        , App (Unapped params (ServerT api Handler)) params+        , Apped (Unapped params (ServerT api Handler)) params ~ ServerT api Handler+        , ParseArgs params+        ) =>   HasServer (WithMatrixParams path params :> api) context where    type ServerT (WithMatrixParams path params :> api) m =-    AddMatrixParams params (ServerT api m)+    Unapped 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+    CaptureRouter $+        route (Proxy :: Proxy api)+              context+              (addMatrices delayed $ \ txt -> case parsePathSegment txt of+                 Nothing -> delayedFail err400+                 Just segment -> if wantedPath == segmentPath segment+                   then return $ (parseArgs $ getSegmentParams segment :: ArgList params)+                   else delayedFail 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+addMatrices :: App fn argList => Delayed env fn+           -> (captured -> DelayedIO (ArgList argList))+           -> Delayed (captured, env) (Apped fn argList)+addMatrices Delayed{..} new =+  Delayed+    { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt+    , serverD   = \ (x, v) a b req -> (`apply` v)  <$> serverD x a b req+    , ..+    }
src/Servant/MatrixParam/Server/Internal.hs view
@@ -12,6 +12,7 @@ import           Data.Maybe import           Data.Text + data MatrixSegment   = MatrixSegment {     segmentPath :: Text,@@ -37,7 +38,7 @@   [flag] -> Just (flag, Nothing)   _ -> Nothing -collectPairs :: forall a b . Show b => Ord a => [(a, Maybe b)] -> Map a b+collectPairs :: forall a b . Ord a => [(a, Maybe b)] -> Map a b collectPairs =   Data.List.foldl'     (\ acc (k, mv) -> maybe acc (\ v -> insert k v acc) mv)
+ src/Servant/MatrixParam/Server/Internal/ArgList.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}+module Servant.MatrixParam.Server.Internal.ArgList where++import qualified Data.Map            as Map+import           Data.Proxy+import qualified Data.Text           as T+import           GHC.TypeLits        (KnownSymbol, symbolVal)+import           Servant.MatrixParam+import           Web.HttpApiData     (parseQueryParamMaybe, FromHttpApiData)++-- An HList that stores the arguments to a function+data ArgList a where+  NoArgs :: ArgList '[]+  (:.:)  :: Maybe a -> ArgList as -> ArgList (MatrixParam key a ': as)++type family Unapped (params :: [*]) end where+  Unapped '[] r = r+  Unapped (MatrixParam key a ': rest) r = Maybe a -> Unapped rest r++class (Apped (Unapped argList fn) argList ~ fn) => App fn (argList :: [*]) where+  type Apped fn argList+  -- Applies a function to an ArgList+  apply :: fn -> ArgList argList -> Apped fn argList++class ParseArgs argList where+  -- Gets the arguments from a map+  parseArgs :: Map.Map T.Text T.Text -> ArgList argList++instance (App r rest+        , Apped (Unapped rest (Maybe a -> r)) rest ~ (Maybe a -> r)+        ) => App (Maybe a -> r) (MatrixParam key a ': rest) where+  type Apped (Maybe a -> r) (MatrixParam key a ': rest) = Apped r rest+  apply fn (a :.: rest) = apply (fn a) rest++instance (FromHttpApiData a, KnownSymbol key, ParseArgs rest) => ParseArgs (MatrixParam key a ': rest) where+  parseArgs m = val :.: (parseArgs m :: ArgList rest)+    where+      key = T.pack $ symbolVal (Proxy :: Proxy key)+      val = Map.lookup key m >>= parseQueryParamMaybe++instance App r '[] where+  type Apped r '[] = r+  apply r _ = r++instance ParseArgs '[] where+  parseArgs _ = NoArgs
test/Servant/MatrixParam/ServerSpec.hs view
@@ -5,7 +5,6 @@ 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@@ -28,8 +27,6 @@  api :: Proxy Api api = Proxy--type Handler = ExceptT ServantErr IO  server :: Server Api server = a :<|> b