Cryptsy/API/Public/Market.hs

   1 module Cryptsy.API.Public.Market
   2         ( GMarket(..), Market
   3         , withComponents, withText
   4         , module Cryptsy.API.Public.Order
   5         , module Cryptsy.API.Public.Trade
   6         -- |Re-exported from Cryptsy.API.Public
   7         , CryptsyNum(..), E8, Fixed
   8         -- |Re-exported from Data.Text
   9         , Text
  10         -- |Re-exported from Data.Aeson
  11         , FromJSON(..), Value, Object
  12         -- |Re-exported from Data.Aeson.Types
  13         , Parser
  14         -- |Re-exported from Data.Vector
  15         , Vector
  16         )
  17 where
  18
  19 -- base
  20 import Control.Applicative ((<$>), (<*>))
  21 import Control.Monad ((>>=))
  22 import Data.Function ((.), ($))
  23 import Data.Traversable (mapM)
  24 import Prelude ()
  25 import Text.Show (Show)
  26
  27 -- text
  28 import Data.Text (Text, pack)
  29
  30 -- aeson
  31 import qualified Data.Aeson as Aeson
  32 import Data.Aeson
  33         ( FromJSON(..), Value, Object, withObject, (.:)
  34         )
  35 import Data.Aeson.Types (Parser)
  36
  37 -- vector
  38 import Data.Vector (Vector)
  39
  40 -- this package
  41 import           Cryptsy.API.Public (CryptsyNum(..), E8, Fixed, withNullableArray)
  42 import           Cryptsy.API.Public.Order (GOrder(Order), Order)
  43 import qualified Cryptsy.API.Public.Order as Order
  44 import           Cryptsy.API.Public.Trade (GTrade(Trade, time), Trade)
  45 import qualified Cryptsy.API.Public.Trade as Trade
  46
  47 data GMarket p q dt t = Market
  48         { marketid :: Text
  49         , label :: Text
  50         , lasttradeprice :: p
  51         , volume :: q
  52         , lasttradetime :: dt
  53         , primaryname :: Text
  54         , primarycode :: Text
  55         , secondaryname :: Text
  56         , secondarycode :: Text
  57         , recenttrades :: Vector (GTrade dt p q t)
  58         , sellorders :: Vector (GOrder p q t)
  59         , buyorders :: Vector (GOrder p q t)
  60         } deriving Show
  61 type Market = GMarket CryptsyNum Text CryptsyNum CryptsyNum
  62
  63 instance (FromJSON p, FromJSON q, FromJSON dt, FromJSON t) =>
  64         FromJSON (GMarket p q dt t)
  65  where
  66         parseJSON = withObject "market"
  67                   $ withComponents parseJSON parseJSON parseJSON parseJSON
  68
  69 -- Combine component parsers into JSON Object parser, for use with
  70 -- 'Aeson.withObject'.
  71 withComponents :: (Value -> Parser p)  -- ^ price parser
  72                -> (Value -> Parser q)  -- ^ quantity parser
  73                -> (Value -> Parser dt) -- ^ date/time parser
  74                -> (Value -> Parser t)  -- ^ total parser
  75                -> Object -> Parser (GMarket p q dt t)
  76 withComponents parsePrice parseQuantity parseDatetime parseTotal =
  77         withAllComponents
  78                 parsePrice
  79                 parseQuantity
  80                 parseDatetime
  81                 parseTrades
  82                 parseOrders
  83                 parseOrders
  84  where
  85         parseTrades =
  86                 withNullableArray "trades" . mapM . withObject "trade"
  87                 $ Trade.withComponents
  88                         parseDatetime
  89                         parsePrice
  90                         parseQuantity
  91                         parseTotal
  92         parseOrders = withNullableArray "orders" . mapM . withObject "order"
  93                     $ Order.withComponents parsePrice parseQuantity parseTotal
  94
  95 -- Special from of withComponents, since API delivers components as JSON
  96 -- Strings.
  97 withText :: (Text -> Parser p)  -- ^ price parser
  98          -> (Text -> Parser q)  -- ^ quantity parser
  99          -> (Text -> Parser dt) -- ^ date/time parser
 100          -> (Text -> Parser t)  -- ^ total parser
 101          -> Object -> Parser (GMarket p q dt t)
 102 withText parsePrice parseQuantity parseDatetime parseTotal = withAllComponents
 103         parseLastTradePrice
 104         parseVolume
 105         parseLastTradeTime
 106         parseRecentTrades
 107         parseSellOrders
 108         parseBuyOrders
 109  where
 110         parseLastTradePrice = Aeson.withText "lasttradeprice" parsePrice
 111         parseVolume         = Aeson.withText "volume"         parseQuantity
 112         parseLastTradeTime  = Aeson.withText "lasttradetime"  parseDatetime
 113         parseRecentTrades   =
 114                 withNullableArray "recenttrades" . mapM . withObject "trade"
 115                 $ Trade.withText
 116                         parseDatetime
 117                         parsePrice
 118                         parseQuantity
 119                         parseTotal
 120         parseSellOrders = withNullableArray "sellorders" $ mapM parseOrder
 121         parseBuyOrders  = withNullableArray "buyorders"  $ mapM parseOrder
 122         parseOrder =
 123                 withObject "order"
 124                 $ Order.withText parsePrice parseQuantity parseTotal
 125
 126 withAllComponents :: (Value -> Parser p)
 127                   -> (Value -> Parser q)
 128                   -> (Value -> Parser dt)
 129                   -> (Value -> Parser (Vector (GTrade dt p q t)))
 130                   -> (Value -> Parser (Vector (GOrder p q t)))
 131                   -> (Value -> Parser (Vector (GOrder p q t)))
 132                   -> Object -> Parser (GMarket p q dt t)
 133 withAllComponents pltp pv pltt prt pso pbo o =
 134         Market                            <$>
 135                  o .: pack "marketid"                 <*>
 136                  o .: pack "label"                    <*>
 137                 (o .: pack "lasttradeprice" >>= pltp) <*>
 138                 (o .: pack "volume"         >>= pv  ) <*>
 139                 (o .: pack "lasttradetime"  >>= pltt) <*>
 140                  o .: pack "primaryname"              <*>
 141                  o .: pack "primarycode"              <*>
 142                  o .: pack "secondaryname"            <*>
 143                  o .: pack "secondarycode"            <*>
 144                 (o .: pack "recenttrades"   >>= prt ) <*>
 145                 (o .: pack "sellorders"     >>= pso ) <*>
 146                 (o .: pack "buyorders"      >>= pbo )