Add missing HasLink instance for DeepQuery (#1784) (#1814)

* Add missing `HasLink` instance for `DeepQuery` (#1784)

* remove Data.Foldable import

* add servant to doctests

* is Data.Maybe evil? 🤔

* undo changes to cabal files

* try and write test for DeepQuery

* fix test

* update test

* Apply feedback by @tchoutri

* other way round!

Author: kutyel

changelog.d/issue-1784

@@ -0,0 +1,6 @@
+synopsis: Add missing HasLink instance for DeepQuery
+issues: #1784
+
+description {
+  Adds missing `HasLink` instance for the `DeepQuery` type.
+}

servant/servant.cabal

@@ -184,6 +184,7 @@ test-suite spec
     , bytestring
     , http-media
     , mtl
+    , network-uri
     , servant
     , text
 

servant/src/Servant/Links.hs

@@ -162,6 +162,8 @@ import           Servant.API.NamedRoutes
                  (NamedRoutes)
 import           Servant.API.QueryParam
                  (QueryFlag, QueryParam', QueryParams)
+import           Servant.API.QueryString
+                 (ToDeepQuery, DeepQuery, generateDeepParam, toDeepQuery)
 import           Servant.API.Raw
                  (Raw, RawM)
 import           Servant.API.RemoteHost
@@ -204,7 +206,7 @@ newtype Escaped = Escaped String
 type Fragment' = Maybe String
 
 escaped :: String -> Escaped
-escaped = Escaped . escapeURIString isUnreserved
+escaped = Escaped . escape
 
 getEscaped :: Escaped -> String
 getEscaped (Escaped s) = s
@@ -683,3 +685,27 @@ instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink
 instance HasLink (MultiVerb method cs as r) where
   type MkLink (MultiVerb method cs as r) a = a
   toLink toA _ = toA
+
+instance (KnownSymbol sym, ToDeepQuery record, HasLink sub) => HasLink (DeepQuery sym record :> sub) where
+  type MkLink (DeepQuery sym record :> sub) a =
+    record -> MkLink sub a
+
+  toLink :: (KnownSymbol sym, ToDeepQuery record, HasLink sub) =>
+    (Link -> a)
+    -> Proxy (DeepQuery sym record :> sub)
+    -> Link
+    -> MkLink (DeepQuery sym record :> sub) a
+  toLink toA _ lnk record =
+    toLink toA (Proxy @sub) $ addParams lnk
+    where
+      k :: Text.Text
+      k = Text.pack $ symbolVal (Proxy @sym)
+
+      mkSingleParam :: ([Text.Text], Maybe Text.Text) -> Param
+      mkSingleParam x =
+        let (a, b) = generateDeepParam k x
+        in SingleParam (Text.unpack a) (Text.pack $ escape $ maybe "" Text.unpack b)
+
+      addParams :: Link -> Link
+      addParams link =
+        List.foldl' (flip (addQueryParam . mkSingleParam)) link $ toDeepQuery record

servant/test/Servant/LinksSpec.hs

@@ -12,10 +12,15 @@ import           Data.Proxy
                  (Proxy (..))
 import           Data.String
                  (fromString)
+import qualified Data.Text as T
+import           Network.URI
+                 (unEscapeString)
 import           Test.Hspec
                  (Expectation, Spec, describe, it, shouldBe)
 
 import           Servant.API
+import           Servant.API.QueryString 
+                 (ToDeepQuery (toDeepQuery))
 import           Servant.Links
 import           Servant.Test.ComprehensiveAPI
                  (comprehensiveAPIWithoutRaw)
@@ -35,6 +40,9 @@ type TestApi =
   -- UVerb
   :<|> "uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent]
 
+  -- DeepQuery
+  :<|> "books" :> DeepQuery "filter" BookQuery :> Get '[JSON] [Book]
+
   -- All of the verbs
   :<|> "get" :> Get '[JSON] NoContent
   :<|> "put" :> Put '[JSON] NoContent
@@ -51,6 +59,18 @@ apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
          => Proxy endpoint -> MkLink endpoint Link
 apiLink = safeLink (Proxy :: Proxy TestApi)
 
+data Book
+data BookQuery = BookQuery 
+  { author :: String
+  , year   :: Int
+  } deriving (Generic, Show, Eq)
+
+instance ToDeepQuery BookQuery where
+  toDeepQuery (BookQuery author year) =
+    [ ([T.pack "author"], Just $ toQueryParam author)
+    , ([T.pack "year"], Just $ toQueryParam year)
+    ]
+
 
 newtype QuuxRoutes mode = QuuxRoutes
   { corge :: mode :- "corge" :> Post '[PlainText] NoContent
@@ -84,6 +104,10 @@ shouldBeLink :: Link -> String -> Expectation
 shouldBeLink link expected =
     toUrlPiece link `shouldBe` fromString expected
 
+shouldBeLinkUnescaped :: Link -> String -> Expectation
+shouldBeLinkUnescaped link expected =
+    unEscapeString (T.unpack $ toUrlPiece link) `shouldBe` fromString expected
+
 (//) :: a -> (a -> b) -> b
 x // f = f x
 infixl 1 //
@@ -152,6 +176,11 @@ spec = describe "Servant.Links" $ do
       (fieldLink foo // garply /: "captureme" /: 42 // waldo)
         `shouldBeLink` "foo/garply/captureme/42/waldo"
 
+    it "generated correct links for DeepQuery" $ do
+      let bFilter = Proxy :: Proxy ("books" :> DeepQuery "filter" BookQuery :> Get '[JSON] [Book])
+      let exampleQuery = BookQuery { author = "Herbert", year = 1965 }
+      apiLink bFilter exampleQuery `shouldBeLinkUnescaped` "books?filter[author]=Herbert&filter[year]=1965"
+
     it "Check links from record fields" $ do
       let sub1 = Proxy :: Proxy ("bar" :> Get '[JSON] NoContent)
       recordApiLink sub1 `shouldBeLink` "bar"