e45bedd · servant · git.iko.soy

src/Servant/Common/Text.hs+4−1

compare with master

unifiedsplit

@@ -11,6 +11,7 @@ import Data.String.Conversions (cs)

11import Data.Text (Text)

12import Data.Text.Read (Reader, decimal, rational, signed)

13import Data.Word (Word, Word16, Word32, Word64, Word8)

14+import GHC.Float (double2Float)

14

15

15-- | For getting values from url captures and query string parameters

16-- | For getting values from url captures and query string parameters

16-- Instances should obey:

17-- Instances should obey:

@@ -130,7 +131,9 @@ instance ToText Double where

130 toText = cs . show

131 toText = cs . show

131

132

132instance FromText Float where

133instance FromText Float where

134+ -- Double is more practically accurate due to weird rounding when using

135+ -- rational. We convert to double and then convert to Float.

133− fromText = runReader rational

136+ fromText = fmap double2Float . runReader rational

134

137

135instance ToText Float where

138instance ToText Float where

136 toText = cs . show

139 toText = cs . show

src/Servant/Utils/Links.hs+3−3

@@ -159,7 +159,7 @@ type family IsElem' a s :: Constraint

159type family IsElem endpoint api :: Constraint where

160 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)

161 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

163 IsElem sa (ReqBody y x :> sb) = IsElem sa sb

164 IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb

165 IsElem sa (QueryParam x y :> sb) = IsElem sa sb

@@ -320,8 +320,8 @@ instance (KnownSymbol sym, HasLink sub)

320 k = symbolVal (Proxy :: Proxy sym)

321

322-- Misc instances

323−instance HasLink sub => HasLink (ReqBody a :> sub) where

323+instance HasLink sub => HasLink (ReqBody ct a :> sub) where

324− type MkLink (ReqBody a :> sub) = MkLink sub

324+ type MkLink (ReqBody ct a :> sub) = MkLink sub

325 toLink _ = toLink (Proxy :: Proxy sub)

326

327instance (ToText v, HasLink sub)

test/Servant/Common/TextSpec.hs+10−2

@@ -55,11 +55,19 @@ spec = describe "Servant.Common.Text" $ do

55 it "holds for Integer" $

56 property $ \x -> textLaw (x :: Integer)

57

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

58 it "holds for Double" $

62 it "holds for Double" $

63+ property $ \x ->

64+ x < 1.0e15 && x > 1.0e-16 ==>

59− property $ \x -> textLaw (x :: Double)

65+ textLaw (x :: Double)

60

66

61 it "holds for Float" $

67 it "holds for Float" $

68+ property $ \x ->

69+ x < 1.0e7 && x > 1.0e-7 ==>

62− property $ \x -> textLaw (x :: Float)

70+ textLaw (x :: Float)

63

71

64textLaw :: (FromText a, ToText a, Eq a) => a -> Bool

72textLaw :: (FromText a, ToText a, Eq a) => a -> Bool

65textLaw a = fromText (toText a) == Just a

73textLaw a = fromText (toText a) == Just a

test/Servant/Utils/LinksSpec.hs+1−1

@@ -29,7 +29,7 @@ type TestApi =

29 :<|> "raw" :> Raw

30

31type TestLink = "hello" :> "hi" :> Get '[JSON] Bool

32−type TestLink2 = "greet" :> Post '[PlainText] Bool

32+type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool

33type TestLink3 = "parent" :> "child" :> Get '[JSON] String

34

35type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool