git.iko.soy/servant
on master help sign in
Merge pull request #26 from haskell-servant/wip-allow-bodies-for-links

Fix a HasLink instance, also fix float text handling/tests.

commite45beddd3559b9a629fe8e8ca027bb727d19bd6b authorJulian Arni <jkarni@gmail.com> dateTue 17 Mar 2015, 09:48 (12 years ago) parent3311cbd7d91e50
4 files changed+18−7
compare with master
unifiedsplit
src/Servant/Common/Text.hs+4−1 src/Servant/Utils/Links.hs+3−3 test/Servant/Common/TextSpec.hs+10−2 test/Servant/Utils/LinksSpec.hs+1−1
src/Servant/Common/Text.hs+4−1
@@ -11,6 +11,7 @@ import Data.String.Conversions (cs)
1111import Data.Text (Text)
1212import Data.Text.Read (Reader, decimal, rational, signed)
1313import Data.Word (Word, Word16, Word32, Word64, Word8)
14+import GHC.Float (double2Float)
1415
1516-- | For getting values from url captures and query string parameters
1617-- Instances should obey:
@@ -130,7 +131,9 @@ instance ToText Double where
130131 toText = cs . show
131132
132133instance FromText Float where
133− fromText = runReader rational
134+ -- Double is more practically accurate due to weird rounding when using
135+ -- rational. We convert to double and then convert to Float.
136+ fromText = fmap double2Float . runReader rational
134137
135138instance ToText Float where
136139 toText = cs . show
src/Servant/Utils/Links.hs+3−3
@@ -159,7 +159,7 @@ type family IsElem' a s :: Constraint
159159type family IsElem endpoint api :: Constraint where
160160 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
161161 IsElem (e :> sa) (e :> sb) = IsElem sa sb
162− IsElem sa (Header x :> sb) = IsElem sa sb
162+ IsElem sa (Header x :> sb) = IsElem sa sb
163163 IsElem sa (ReqBody y x :> sb) = IsElem sa sb
164164 IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
165165 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
@@ -320,8 +320,8 @@ instance (KnownSymbol sym, HasLink sub)
320320 k = symbolVal (Proxy :: Proxy sym)
321321
322322-- Misc instances
323−instance HasLink sub => HasLink (ReqBody a :> sub) where
324− type MkLink (ReqBody a :> sub) = MkLink sub
323+instance HasLink sub => HasLink (ReqBody ct a :> sub) where
324+ type MkLink (ReqBody ct a :> sub) = MkLink sub
325325 toLink _ = toLink (Proxy :: Proxy sub)
326326
327327instance (ToText v, HasLink sub)
test/Servant/Common/TextSpec.hs+10−2
@@ -55,11 +55,19 @@ spec = describe "Servant.Common.Text" $ do
5555 it "holds for Integer" $
5656 property $ \x -> textLaw (x :: Integer)
5757
58+ -- The following two properties are only reasonably expected to hold up
59+ -- to a certain precision.
60+ --
61+ -- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
5862 it "holds for Double" $
59− property $ \x -> textLaw (x :: Double)
63+ property $ \x ->
64+ x < 1.0e15 && x > 1.0e-16 ==>
65+ textLaw (x :: Double)
6066
6167 it "holds for Float" $
62− property $ \x -> textLaw (x :: Float)
68+ property $ \x ->
69+ x < 1.0e7 && x > 1.0e-7 ==>
70+ textLaw (x :: Float)
6371
6472textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
6573textLaw a = fromText (toText a) == Just a
test/Servant/Utils/LinksSpec.hs+1−1
@@ -29,7 +29,7 @@ type TestApi =
2929 :<|> "raw" :> Raw
3030
3131type TestLink = "hello" :> "hi" :> Get '[JSON] Bool
32−type TestLink2 = "greet" :> Post '[PlainText] Bool
32+type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool
3333type TestLink3 = "parent" :> "child" :> Get '[JSON] String
3434
3535type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool