on master help sign in
Merge pull request #666 from phadej/bug-fix-for-haslink

Bug fix for haslink

commit8822c12530d64b2c2d8cf65676abc0c961b14abe authorOleg Grenrus <oleg.grenrus@iki.fi> dateMon 16 Jan 2017, 11:01 (10 years ago) parentcfaa7a02b12436
5 files changed+38−32
servant/CHANGELOG.md+4 servant/src/Servant/API.hs+1−1 servant/src/Servant/Utils/Links.hs+16−14 servant/test/Servant/Utils/LinksSpec.hs+16−15 stack.yaml+1−2
servant/CHANGELOG.md+4
@@ -4,6 +4,10 @@
44* Use `NT` from `natural-transformation` for `Enter`
55 ([#616](https://github.com/haskell-servant/servant/issues/616))
66
7+* Change to `MkLink (Verb ...) = Link` (previously `URI`). To consume `Link`
8+ use its `ToHttpApiData` instance or `linkURI`.
9+ ([#527](https://github.com/haskell-servant/servant/issues/527))
10+
7110.9.1
812------
913
servant/src/Servant/API.hs+1−1
@@ -101,7 +101,7 @@ import Servant.API.Verbs (PostCreated, Delete, DeleteAccepte
101101 ReflectMethod (reflectMethod),
102102 Verb, StdMethod(..))
103103import Servant.API.WithNamedContext (WithNamedContext)
104−import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
104+import Servant.Utils.Links (HasLink (..), Link, IsElem, IsElem',
105105 URI (..), safeLink)
106106import Web.HttpApiData (FromHttpApiData (..),
107107 ToHttpApiData (..))
servant/src/Servant/Utils/Links.hs+16−14
@@ -30,7 +30,7 @@
3030-- you would like to restrict links to. The second argument is the destination
3131-- endpoint you would like the link to point to, this will need to end with a
3232-- verb like GET or POST. Further arguments may be required depending on the
33−-- type of the endpoint. If everything lines up you will get a 'URI' out the
33+-- type of the endpoint. If everything lines up you will get a 'Link' out the
3434-- other end.
3535--
3636-- You may omit 'QueryParam's and the like should you not want to provide them,
@@ -41,19 +41,19 @@
4141-- with an example. Here, a link is generated with no parameters:
4242--
4343-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
44−-- >>> print (safeLink api hello :: URI)
45−-- hello
44+-- >>> toUrlPiece (safeLink api hello :: Link)
45+-- "hello"
4646--
4747-- If the API has an endpoint with parameters then we can generate links with
4848-- or without those:
4949--
5050-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
51−-- >>> print $ safeLink api with (Just "Hubert")
52−-- bye?name=Hubert
51+-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
52+-- "bye?name=Hubert"
5353--
5454-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
55−-- >>> print $ safeLink api without
56−-- bye
55+-- >>> toUrlPiece $ safeLink api without
56+-- "bye"
5757--
5858-- If you would like create a helper for generating links only within that API,
5959-- you can partially apply safeLink if you specify a correct type signature
@@ -94,11 +94,11 @@ module Servant.Utils.Links (
9494 , Or
9595) where
9696
97−import qualified Data.ByteString.Char8 as BSC
9897import Data.List
9998import Data.Monoid.Compat ( (<>) )
10099import Data.Proxy ( Proxy(..) )
101100import qualified Data.Text as Text
101+import qualified Data.Text.Encoding as TE
102102import GHC.Exts (Constraint)
103103import GHC.TypeLits ( KnownSymbol, symbolVal )
104104import Network.URI ( URI(..), escapeURIString, isUnreserved )
@@ -126,8 +126,10 @@ data Link = Link
126126 } deriving Show
127127
128128instance ToHttpApiData Link where
129− toUrlPiece = Text.pack . show
130− toHeader = BSC.pack . show
129+ toHeader = TE.encodeUtf8 . toUrlPiece
130+ toUrlPiece l =
131+ let uri = linkURI l
132+ in Text.pack $ uriPath uri ++ uriQuery uri
131133
132134-- | If either a or b produce an empty constraint, produce an empty constraint.
133135type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
@@ -307,9 +309,9 @@ instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
307309
308310-- Verb (terminal) instances
309311instance HasLink (Verb m s ct a) where
310− type MkLink (Verb m s ct a) = URI
311− toLink _ = linkURI
312+ type MkLink (Verb m s ct a) = Link
313+ toLink _ = id
312314
313315instance HasLink Raw where
314− type MkLink Raw = URI
315− toLink _ = linkURI
316+ type MkLink Raw = Link
317+ toLink _ = id
servant/test/Servant/Utils/LinksSpec.hs+16−15
@@ -7,6 +7,7 @@ module Servant.Utils.LinksSpec where
77import Data.Proxy (Proxy (..))
88import Test.Hspec (Expectation, Spec, describe, it,
99 shouldBe)
10+import Data.String (fromString)
1011
1112import Servant.API
1213
@@ -32,38 +33,38 @@ apiLink = safeLink (Proxy :: Proxy TestApi)
3233
3334-- | Convert a link to a URI and ensure that this maps to the given string
3435-- given string
35−shouldBeURI :: URI -> String -> Expectation
36−shouldBeURI link expected =
37− show link `shouldBe` expected
36+shouldBeLink :: Link -> String -> Expectation
37+shouldBeLink link expected =
38+ toUrlPiece link `shouldBe` fromString expected
3839
3940spec :: Spec
4041spec = describe "Servant.Utils.Links" $ do
4142 it "generates correct links for capture query params" $ do
4243 let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] NoContent)
43− apiLink l1 "hi" `shouldBeURI` "hello/hi"
44+ apiLink l1 "hi" `shouldBeLink` "hello/hi"
4445
4546 let l2 = Proxy :: Proxy ("hello" :> Capture "name" String
4647 :> QueryParam "capital" Bool
4748 :> Delete '[JSON] NoContent)
48− apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
49+ apiLink l2 "bye" (Just True) `shouldBeLink` "hello/bye?capital=true"
4950
5051 it "generates correct links for CaptureAll" $ do
5152 apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))
5253 ["roads", "lead", "to", "rome"]
53− `shouldBeURI` "all/roads/lead/to/rome"
54+ `shouldBeLink` "all/roads/lead/to/rome"
5455
5556 it "generates correct links for query flags" $ do
5657 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
5758 :> QueryFlag "fast" :> Delete '[JSON] NoContent)
58− apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
59− apiLink l1 False True `shouldBeURI` "balls?fast"
59+ apiLink l1 True True `shouldBeLink` "balls?bouncy&fast"
60+ apiLink l1 False True `shouldBeLink` "balls?fast"
6061
6162 it "generates correct links for all of the verbs" $ do
62− apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeURI` "get"
63− apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeURI` "put"
64− apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeURI` "post"
65− apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeURI` "delete"
66− apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
63+ apiLink (Proxy :: Proxy ("get" :> Get '[JSON] NoContent)) `shouldBeLink` "get"
64+ apiLink (Proxy :: Proxy ("put" :> Put '[JSON] NoContent)) `shouldBeLink` "put"
65+ apiLink (Proxy :: Proxy ("post" :> Post '[JSON] NoContent)) `shouldBeLink` "post"
66+ apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
67+ apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
6768
6869
6970-- |
@@ -96,8 +97,8 @@ spec = describe "Servant.Utils.Links" $ do
9697-- ...
9798--
9899-- sanity check
99−-- >>> apiLink (Proxy :: Proxy AllGood)
100−-- get
100+-- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)
101+-- "get"
101102type WrongPath = "getTypo" :> Get '[JSON] NoContent
102103type WrongReturnType = "get" :> Get '[JSON] Bool
103104type WrongContentType = "get" :> Get '[OctetStream] NoContent
stack.yaml+1−2
@@ -15,5 +15,4 @@ extra-deps:
1515- hspec-core-2.3.2
1616- hspec-wai-0.8.0
1717- hspec-expectations-0.8.2
18−- call-stack-0.1.0
19−resolver: lts-6.0
18+resolver: lts-6.27