Add NewMarket, bump to 0.5

dmjio · Dec 30, 2017 · 5bbbcf5 · 5bbbcf5
1 parent fc1949e
commit 5bbbcf5
Show file tree

Hide file tree

Showing 7 changed files with 52 additions and 40 deletions.
diff --git a/README.md b/README.md
@@ -28,40 +28,39 @@ main = do
   -- Public Usage
   putStrLn "Markets"
   Right ms <- getMarkets
-  forM_ ms $ \m ->
-    T.putStrLn (marketName m)
+  forM_ ms (print . marketName)
 
   putStrLn "Currencies"
   Right cs <- getCurrencies
   mapM_ print cs
 
   putStrLn "Ticker for BTC-DOGE market"
-  t <- getTicker BTC_DOGE
+  t <- getTicker (MarketName BTC_DOGE)
   print t
 
   putStrLn "Summary of BTC-DOGE market"
-  Right t <- getMarketSummary BTC_DOGE
+  Right t <- getMarketSummary (MarketName BTC_DOGE)
   print t
 
   putStrLn "Get market summaries"
   Right t <- getMarketSummaries
   print t
 
   putStrLn "Order book sells for for BTC-DOGE market"
-  book <- getOrderBookSells BTC_DOGE
+  book <- getOrderBookSells (MarketName BTC_DOGE)
   print book
 
   putStrLn "Order book buys for for BTC-DOGE market"
-  book <- getOrderBookBuys BTC_DOGE
+  book <- getOrderBookBuys (MarketName BTC_DOGE)
   print book
 
   putStrLn "Market history for BTC-DOGE"
-  Right history <- getMarketHistory BTC_DOGE
+  Right history <- getMarketHistory (MarketName BTC_DOGE)
   forM_ history print
 
   -- Market usage
   putStrLn "Retrieve your open orders"
-  Right openOrders <- getOpenOrders keys BTC_DOGE
+  Right openOrders <- getOpenOrders keys (MarketName BTC_DOGE)
   forM_ openOrders print
 
   -- Account usage,

diff --git a/bittrex.cabal b/bittrex.cabal
@@ -1,5 +1,5 @@
 name:                bittrex
-version:             0.4.0.0
+version:             0.5.0.0
 synopsis:            API bindings to bittrex.com
 description:         Haskell bindings to the Bittrex exchange
 homepage:            https://github.com/dmjio/bittrex

diff --git a/bittrex.nix b/bittrex.nix
@@ -3,7 +3,7 @@
 }:
 mkDerivation {
   pname = "bittrex";
-  version = "0.4.0.0";
+  version = "0.5.0.0";
   src = ./.;
   isLibrary = true;
   isExecutable = true;

diff --git a/example/Main.hs b/example/Main.hs
@@ -20,32 +20,32 @@ main = do
   mapM_ print cs
 
   putStrLn "Ticker for BTC-DOGE market"
-  t <- getTicker BTC_DOGE
+  t <- getTicker (MarketName BTC_DOGE)
   print t
 
   putStrLn "Summary of BTC-DOGE market"
-  Right t <- getMarketSummary BTC_DOGE
+  Right t <- getMarketSummary (MarketName BTC_DOGE)
   print t
 
   putStrLn "Get market summaries"
   Right t <- getMarketSummaries
   print t
 
   putStrLn "Order book sells for for BTC-DOGE market"
-  book <- getOrderBookSells BTC_DOGE
+  book <- getOrderBookSells (MarketName BTC_DOGE)
   print book
 
   putStrLn "Order book buys for for BTC-DOGE market"
-  book <- getOrderBookBuys BTC_DOGE
+  book <- getOrderBookBuys (MarketName BTC_DOGE)
   print book
 
   putStrLn "Market history for BTC-DOGE"
-  Right history <- getMarketHistory BTC_DOGE
+  Right history <- getMarketHistory (MarketName BTC_DOGE)
   forM_ history print
 
   -- Market usage
   putStrLn "Retrieve your open orders"
-  Right openOrders <- getOpenOrders keys BTC_DOGE
+  Right openOrders <- getOpenOrders keys (MarketName BTC_DOGE)
   forM_ openOrders print
 
   -- Account usage,

diff --git a/src/Bittrex/API.hs b/src/Bittrex/API.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE LambdaCase          #-}
 module Bittrex.API
   (
     -- * Overview
@@ -72,7 +73,7 @@ getTicker
   -> IO (Either ErrorMessage Ticker)
 getTicker market =
   callAPI defOpts {
-      qParams = [("market", camelToDash $ show market)]
+      qParams = [("market", toMarket market)]
     , path = "getticker"
     }
 
@@ -88,7 +89,7 @@ getMarketSummary
   -> IO (Either ErrorMessage [MarketSummary])
 getMarketSummary market =
   callAPI defOpts {
-      qParams = pure ("market", camelToDash $ show market)
+      qParams = pure ("market", toMarket market)
     , path = "getmarketsummary"
     }
 
@@ -100,7 +101,7 @@ getOrderBookBuys
 getOrderBookBuys market =
   callAPI defOpts {
       path = "getorderbook"
-    , qParams = [ ("market", camelToDash $ show market)
+    , qParams = [ ("market", toMarket market)
                 , ("type", "buy")
                 ]
     }
@@ -113,7 +114,7 @@ getOrderBookSells
 getOrderBookSells market =
   callAPI defOpts {
       path = "getorderbook"
-    , qParams = [ ("market", camelToDash $ show market)
+    , qParams = [ ("market", toMarket market)
                 , ("type", "sell")
                 ]
     }
@@ -125,7 +126,7 @@ getMarketHistory
 getMarketHistory market =
   callAPI defOpts {
       path = "getmarkethistory"
-    , qParams = pure ("market", camelToDash $ show market)
+    , qParams = pure ("market", toMarket market)
     }
 
 -- | Get all orders that you currently have opened. A specific market can be requested
@@ -137,7 +138,7 @@ getOpenOrders keys market =
   callAPI defOpts {
       path      = "getopenorders"
     , apiType   = MarketAPI
-    , qParams   = pure ("market", camelToDash $ show market)
+    , qParams   = pure ("market", toMarket market)
     , keys      = keys
     }
 
@@ -153,7 +154,7 @@ buyLimit keys market quantity rate =
       path      = "buylimit"
     , keys      = keys
     , apiType   = MarketAPI
-    , qParams   = [ ("market", camelToDash $ show market )
+    , qParams   = [ ("market", toMarket market )
                   , ("quantity", show quantity )
                   , ("rate", show rate )
                   ]
@@ -172,7 +173,7 @@ sellLimit keys market quantity rate =
       path      = "selllimit"
     , keys      = keys
     , apiType   = MarketAPI
-    , qParams   = [ ("market", camelToDash $ show market )
+    , qParams   = [ ("market", toMarket market )
                   , ("quantity", show quantity )
                   , ("rate", show rate )
                   ]
@@ -254,7 +255,7 @@ getOrderHistory keys market =
       path    = "getorderhistory"
     , apiType = AccountAPI
     , keys    = keys
-    , qParams = [ ("market", camelToDash (show m) )
+    , qParams = [ ("market", toMarket m )
                 | Just m <- pure market
                 ]
     }

diff --git a/src/Bittrex/Types.hs b/src/Bittrex/Types.hs
@@ -3,17 +3,17 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Bittrex.Types where
 
-import           Bittrex.Util         (parse)
 import           Data.Aeson
 import           Data.Aeson.Types     hiding (parse)
 import           Data.ByteString      (ByteString)
 import qualified Data.ByteString      as B
 import qualified Data.ByteString.Lazy as L
+import           Data.Fixed
 import           Data.Scientific
 import           Data.Text            (Text)
 import qualified Data.Text            as T
-import           Data.Fixed
 import           Data.Time
+import           Data.Time.Format
 import           GHC.Generics
 import           Text.Read            (readMaybe)
 
@@ -36,6 +36,12 @@ newtype Time = Time UTCTime
 instance FromJSON Time where
   parseJSON = withText "Time" $ \t -> do
     pure $ Time $ parse (T.unpack t)
+      where
+        parse :: String -> UTCTime
+        parse =
+          parseTimeOrError True defaultTimeLocale $
+            iso8601DateFormat (Just "%H:%M:%S%Q")
+
 
 instance Show APIType where
   show AccountAPI = "account"
@@ -73,6 +79,17 @@ instance FromJSON ErrorMessage
 instance FromJSON BittrexError
 
 data MarketName
+  = NewMarket Text
+  | MarketName MarketName'
+  deriving (Show, Eq)
+
+instance FromJSON MarketName where
+  parseJSON = withText "Market Name" $ \t ->
+    pure $ case readMaybe $ T.unpack (T.replace "-" "_" t) of
+       Nothing -> NewMarket t
+       Just k -> MarketName k
+
+data MarketName'
   = BTC_LTC
   | BTC_DOGE
   | BTC_VTC
@@ -346,12 +363,6 @@ data MarketName
   | ETH_UKG
   deriving (Show, Eq, Generic, Read)
 
-instance FromJSON MarketName where
-  parseJSON = withText "MarketName" $ \s ->
-    case readMaybe $ T.unpack (T.replace "-" "_" s) of
-      Nothing -> error $ "Couldn't parse MarketName: " ++ T.unpack s
-      Just k -> pure k
-
 newtype Bid = Bid (Fixed E8)
   deriving (Show, Eq, Num, FromJSON)
 

diff --git a/src/Bittrex/Util.hs b/src/Bittrex/Util.hs
@@ -1,14 +1,15 @@
-module Bittrex.Util ( camelToDash, parse ) where
+module Bittrex.Util ( toMarket ) where
 
-import Data.Time
-import Data.Time.Format
+import           Data.Text        (Text)
+import qualified Data.Text        as T
+
+import           Bittrex.Types
 
 camelToDash :: String -> String
 camelToDash [] = []
 camelToDash ('_':xs) = '-':camelToDash xs
 camelToDash (x:xs) = x:camelToDash xs
 
-parse :: String -> UTCTime
-parse =
-  parseTimeOrError True defaultTimeLocale $
-    iso8601DateFormat (Just "%H:%M:%S%Q")
+toMarket :: MarketName -> String
+toMarket (NewMarket t) = T.unpack t
+toMarket (MarketName k) = camelToDash (show k)