Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
divarvel committed Apr 23, 2024
1 parent 5dac462 commit d387119
Show file tree
Hide file tree
Showing 4 changed files with 34 additions and 24 deletions.
8 changes: 0 additions & 8 deletions servant-client-core/src/Servant/Client/Core/HasClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -678,14 +678,6 @@ instance (HasClient m api)
hoistClientMonad pm _ f cl = \b ->
hoistClientMonad pm (Proxy :: Proxy api) f (cl b)

class ToDeepQuery a where
toDeepQuery :: a -> [([T.Text], Maybe T.Text)]

generateDeepParam :: T.Text -> ([T.Text], Maybe T.Text) -> (T.Text, Maybe T.Text)
generateDeepParam name (keys, value) =
let makeKeySegment key = "[" <> key <> "]"
in (name <> foldMap makeKeySegment keys, value)

instance (KnownSymbol sym, ToDeepQuery a, HasClient m api)
=> HasClient m (DeepQuery sym a :> api) where
type Client m (DeepQuery sym a :> api) =
Expand Down
16 changes: 0 additions & 16 deletions servant-server/src/Servant/Server/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -728,22 +728,6 @@ parseDeepParam (paramname, value) =
_ -> Left $ "Error parsing deep param, missing opening '[': " <> T.unpack remaining
in (, value) <$> parseParam paramname

-- | Extract a deep object from (possibly nested) query parameters.
-- a param like @filter[a][b][c]=d@ will be represented as
-- @'(["a", "b", "c"], Just "d")'@. Note that a parameter with no
-- nested field is possible: @filter=a@ will be represented as
-- @'([], Just "a")'@
class FromDeepQuery a where
fromDeepQuery :: [([T.Text], Maybe T.Text)] -> Either String a

instance FromHttpApiData a => FromDeepQuery (Map.Map T.Text a) where
fromDeepQuery params =
let parseParam ([k], Just rawV) = (k,) <$> first T.unpack (parseQueryParam rawV)
parseParam (_, Nothing) = Left "Empty map value"
parseParam ([], _) = Left "Empty map parameter"
parseParam (_ , Just _) = Left "Nested map values"
in Map.fromList <$> traverse parseParam params

-- | Just pass the request to the underlying application and serve its response.
--
-- Example:
Expand Down
1 change: 1 addition & 0 deletions servant/servant.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,7 @@ library
base >= 4.9 && < 4.20
, bytestring >= 0.10.8.1 && < 0.13
, constraints >= 0.2
, containers >= 0.6 && < 0.7
, mtl ^>= 2.2.2 || ^>= 2.3.1
, sop-core >= 0.4.0.0 && < 0.6
, transformers >= 0.5.2.0 && < 0.7
Expand Down
33 changes: 33 additions & 0 deletions servant/src/Servant/API/QueryString.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,10 @@
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.QueryString (QueryString, DeepQuery) where

import Data.Kind (Type)
import Data.Map.Strict (Map)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
(Typeable)
import GHC.TypeLits
Expand Down Expand Up @@ -37,3 +41,32 @@ data DeepQuery (sym :: Symbol) (a :: Type)
-- >>> data Book
-- >>> data BookQuery
-- >>> instance ToJSON Book where { toJSON = undefined }

-- | Extract a deep object from (possibly nested) query parameters.
-- a param like @filter[a][b][c]=d@ will be represented as
-- @'(["a", "b", "c"], Just "d")'@. Note that a parameter with no
-- nested field is possible: @filter=a@ will be represented as
-- @'([], Just "a")'@
class FromDeepQuery a where
fromDeepQuery :: [([Text], Maybe Text)] -> Either String a

instance FromHttpApiData a => FromDeepQuery (Map.Map Text a) where
fromDeepQuery params =
let parseParam ([k], Just rawV) = (k,) <$> first T.unpack (parseQueryParam rawV)
parseParam (_, Nothing) = Left "Empty map value"
parseParam ([], _) = Left "Empty map parameter"
parseParam (_ , Just _) = Left "Nested map values"
in Map.fromList <$> traverse parseParam params

-- | Generate query parameters from an object, using the deep object syntax.
-- A result of @'(["a", "b", "c"], Just "d")'@ attributed to the @filter@
-- parameter name will result in the following query parameter:
-- @filter[a][b][c]=d@
class ToDeepQuery a where
toDeepQuery :: a -> [([Text], Maybe Text)]

generateDeepParam :: Text -> ([Text], Maybe Text) -> (Text, Maybe Text)
generateDeepParam name (keys, value) =
let makeKeySegment key = "[" <> key <> "]"
in (name <> foldMap makeKeySegment keys, value)

0 comments on commit d387119

Please sign in to comment.