Cryptsy/API/Public/SingleMarket.hs

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