From e721eb2f719b0f4808e1686c7dd721f72bb9c149 Mon Sep 17 00:00:00 2001
From: Boyd Stephen Smith Jr <bss@iguanasuicide.net>
Date: Sat, 23 Nov 2013 15:03:18 -0600
Subject: [PATCH] Treat JSON null as an empty JSON array.

Fixes issue seen "in the wild".
---
 Cryptsy/API/Public/Market.hs | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/Cryptsy/API/Public/Market.hs b/Cryptsy/API/Public/Market.hs
index 2e30666..6bb9f47 100644
--- a/Cryptsy/API/Public/Market.hs
+++ b/Cryptsy/API/Public/Market.hs
@@ -17,8 +17,10 @@ where
 
 -- base
 import Control.Applicative ((<$>), (<*>))
-import Control.Monad ((>>=))
+import Control.Monad (return, (>>=))
 import Data.Function ((.), ($))
+import Data.Monoid (Monoid(mempty))
+import Data.String (String)
 import Data.Traversable (mapM)
 import Prelude ()
 import Text.Show (Show)
@@ -29,9 +31,9 @@ import Data.Text (Text, pack)
 -- aeson
 import qualified Data.Aeson as Aeson
 import Data.Aeson
-	( FromJSON(..), Value, Object, withObject, withArray, (.:)
+	( FromJSON(..), Value(Array, Null), Array, Object, withObject, (.:)
 	)
-import Data.Aeson.Types (Parser)
+import Data.Aeson.Types (Parser, typeMismatch)
 
 -- vector
 import Data.Vector (Vector)
@@ -65,6 +67,12 @@ instance (FromJSON p, FromJSON q, FromJSON dt, FromJSON t) =>
 	parseJSON = withObject "market"
 	          $ withComponents parseJSON parseJSON parseJSON parseJSON
 
+withNullableArray :: (Monoid a)
+                  => String -> (Array -> Parser a) -> Value -> Parser a
+withNullableArray _    parseArray (Array v) = parseArray v
+withNullableArray _    _           Null     = return mempty
+withNullableArray name _           v        = typeMismatch name v
+
 -- Combine component parsers into JSON Object parser, for use with
 -- 'Aeson.withObject'.
 withComponents :: (Value -> Parser p)  -- ^ price parser
@@ -82,13 +90,13 @@ withComponents parsePrice parseQuantity parseDatetime parseTotal =
 		parseOrders
  where
 	parseTrades =
-		withArray "trades" . mapM . withObject "trade"
+		withNullableArray "trades" . mapM . withObject "trade"
 		$ Trade.withComponents
 			parseDatetime
 			parsePrice
 			parseQuantity
 			parseTotal
-	parseOrders = withArray "orders" . mapM . withObject "order"
+	parseOrders = withNullableArray "orders" . mapM . withObject "order"
 	            $ Order.withComponents parsePrice parseQuantity parseTotal
 
 -- Special from of withComponents, since API delivers components as JSON
@@ -110,14 +118,14 @@ withText parsePrice parseQuantity parseDatetime parseTotal = withAllComponents
 	parseVolume         = Aeson.withText "volume"         parseQuantity
 	parseLastTradeTime  = Aeson.withText "lasttradetime"  parseDatetime
 	parseRecentTrades   =
-		withArray "recenttrades" . mapM . withObject "trade"
+		withNullableArray "recenttrades" . mapM . withObject "trade"
 		$ Trade.withText
 			parseDatetime
 			parsePrice
 			parseQuantity
 			parseTotal
-	parseSellOrders = withArray "sellorders" $ mapM parseOrder
-	parseBuyOrders  = withArray "buyorders"  $ mapM parseOrder
+	parseSellOrders = withNullableArray "sellorders" $ mapM parseOrder
+	parseBuyOrders  = withNullableArray "buyorders"  $ mapM parseOrder
 	parseOrder =
 		withObject "order"
 		$ Order.withText parsePrice parseQuantity parseTotal
-- 
2.11.4.GIT