From 134ca1f2a8af30cc376fb63b13b26b9f05438339 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Tue, 26 Aug 2014 22:38:09 -0700
Subject: [PATCH] Parse JSON -> SqlValue as Int as well as Double when possible

---
 src/Types.hs               | 11 ++++++-----
 test/Feature/InsertSpec.hs |  4 ++--
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/Types.hs b/src/Types.hs
index ea9ad8ffe..86f9173ea 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -2,22 +2,22 @@
 
 module Types(SqlRow(SqlRow), getRow) where
 
-import Database.HDBC (toSql, SqlValue(..))
+import Database.HDBC (toSql, iToSql, SqlValue(..))
 
 import qualified Data.Aeson as JSON
 import Data.Aeson.Types (Parser)
 
-import Data.Scientific (toRealFloat)
+import Data.Scientific (floatingOrInteger)
 import Data.HashMap.Strict (foldlWithKey')
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Calendar (showGregorian)
 
-import Control.Monad(mzero)
+import Control.Monad (mzero)
 
 instance JSON.FromJSON SqlValue where
+  parseJSON (JSON.Number n)    = return $ either toSql iToSql (floatingOrInteger n :: Either Double Int)
   parseJSON (JSON.String s)    = return $ toSql s
-  parseJSON (JSON.Number n)    = return $ toSql (toRealFloat n::Double)
   parseJSON (JSON.Bool   b)    = return $ toSql b
   parseJSON JSON.Null          = return SqlNull
   parseJSON (JSON.Object o)    = return . toSql $ JSON.encode o
@@ -42,7 +42,8 @@ instance JSON.ToJSON SqlValue where
   toJSON x                     = JSON.toJSON $ show x
 
 
-newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] }
+newtype SqlRow = SqlRow {getRow :: [(Text, SqlValue)] } deriving (Show)
+
 instance JSON.FromJSON SqlRow where
   parseJSON (JSON.Object m) = foldlWithKey' add (return $ SqlRow []) m
     where
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index 68e3e21c6..037a4a556 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -57,7 +57,7 @@ spec = around appWithFixture $
       it "builds response location header appropriately" $
         post "/compound_pk" [json| { "k1":12, "k2":42 } |]
           `shouldRespondWith` ResponseMatcher {
-            matchBody    = Just "compare with error",
+            matchBody    = Nothing,
             matchStatus  = 201,
-            matchHeaders = [("Location", "/auto_incrementing_pk?k1=eq.12&k2=eq.42")]
+            matchHeaders = [("Location", "/compound_pk?k1=eq.12&k2=eq.42")]
           }