Merge pull request #26 from haskell-servant/wip-allow-bodies-for-links

Fix a HasLink instance, also fix float text handling/tests.
This commit is contained in:
Julian Arni 2015-03-17 09:48:53 +01:00
commit e45beddd35
4 changed files with 18 additions and 7 deletions

View file

@ -11,6 +11,7 @@ import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Read (Reader, decimal, rational, signed) import Data.Text.Read (Reader, decimal, rational, signed)
import Data.Word (Word, Word16, Word32, Word64, Word8) import Data.Word (Word, Word16, Word32, Word64, Word8)
import GHC.Float (double2Float)
-- | For getting values from url captures and query string parameters -- | For getting values from url captures and query string parameters
-- Instances should obey: -- Instances should obey:
@ -130,7 +131,9 @@ instance ToText Double where
toText = cs . show toText = cs . show
instance FromText Float where instance FromText Float where
fromText = runReader rational -- Double is more practically accurate due to weird rounding when using
-- rational. We convert to double and then convert to Float.
fromText = fmap double2Float . runReader rational
instance ToText Float where instance ToText Float where
toText = cs . show toText = cs . show

View file

@ -320,8 +320,8 @@ instance (KnownSymbol sym, HasLink sub)
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
-- Misc instances -- Misc instances
instance HasLink sub => HasLink (ReqBody a :> sub) where instance HasLink sub => HasLink (ReqBody ct a :> sub) where
type MkLink (ReqBody a :> sub) = MkLink sub type MkLink (ReqBody ct a :> sub) = MkLink sub
toLink _ = toLink (Proxy :: Proxy sub) toLink _ = toLink (Proxy :: Proxy sub)
instance (ToText v, HasLink sub) instance (ToText v, HasLink sub)

View file

@ -55,11 +55,19 @@ spec = describe "Servant.Common.Text" $ do
it "holds for Integer" $ it "holds for Integer" $
property $ \x -> textLaw (x :: Integer) property $ \x -> textLaw (x :: Integer)
-- The following two properties are only reasonably expected to hold up
-- to a certain precision.
--
-- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
it "holds for Double" $ it "holds for Double" $
property $ \x -> textLaw (x :: Double) property $ \x ->
x < 1.0e15 && x > 1.0e-16 ==>
textLaw (x :: Double)
it "holds for Float" $ it "holds for Float" $
property $ \x -> textLaw (x :: Float) property $ \x ->
x < 1.0e7 && x > 1.0e-7 ==>
textLaw (x :: Float)
textLaw :: (FromText a, ToText a, Eq a) => a -> Bool textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
textLaw a = fromText (toText a) == Just a textLaw a = fromText (toText a) == Just a

View file

@ -29,7 +29,7 @@ type TestApi =
:<|> "raw" :> Raw :<|> "raw" :> Raw
type TestLink = "hello" :> "hi" :> Get '[JSON] Bool type TestLink = "hello" :> "hi" :> Get '[JSON] Bool
type TestLink2 = "greet" :> Post '[PlainText] Bool type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool
type TestLink3 = "parent" :> "child" :> Get '[JSON] String type TestLink3 = "parent" :> "child" :> Get '[JSON] String
type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool