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