diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,14 @@ # CryptoCompare [![Build Status](https://travis-ci.org/aviaviavi/cryptocompare.svg?branch=master)](https://travis-ci.org/aviaviavi/cryptocompare) +[![Hackage](https://img.shields.io/hackage/v/cryptocompare.svg)](https://hackage.haskell.org/package/cryptocompare-0.0.3) A Haskell wrapper to the public [CryptoCompare API](https://www.cryptocompare.com/api/), a -source of information and pricing of different crypto currencies +source of information and pricing of different crypto currencies. See hackage for API documentation. ## State This library is usable but not complete. It currently covers a subset of the API. -Breaking changes will occur if necessary but will be avoided if possible. ## Contributing diff --git a/cryptocompare.cabal b/cryptocompare.cabal --- a/cryptocompare.cabal +++ b/cryptocompare.cabal @@ -1,5 +1,5 @@ name: cryptocompare -version: 0.0.3 +version: 0.1.0 synopsis: Haskell wrapper for the cryptocompare API description: Haskell wrapper for the cryptocompare API, a source of information and pricing of different crypto-currencies. @@ -17,7 +17,6 @@ library hs-source-dirs: src exposed-modules: CryptoCompare - build-depends: base >= 4.7 && < 5 default-language: Haskell2010 build-depends: base >= 4.8 && < 5 , directory @@ -38,6 +37,9 @@ main-is: Spec.hs build-depends: base , cryptocompare + , hspec >= 2.4.4 + , hspec-expectations + , MissingH ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/src/CryptoCompare.hs b/src/CryptoCompare.hs --- a/src/CryptoCompare.hs +++ b/src/CryptoCompare.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} -- | A haskell wrapper for the cryptocompare API, a source of information and pricing of different crypto currencies -- @@ -33,7 +33,7 @@ , PriceResponse(..) ) where -import Control.Monad.Catch +import qualified Control.Exception as E import Control.Monad.IO.Class import Data.Aeson import Data.Aeson.Types @@ -238,6 +238,9 @@ parseJSON x = parseJSON x >>= mapM parseCointListResponseData . toList +showError :: HttpException -> Either String a +showError = Left . show + -- Since this entry uses keys that we don't know ahead of time, we -- need to do some special parsing that doesn't require it. parseCointListResponseData :: (String, Value) -> Parser CoinDetails @@ -264,11 +267,13 @@ -- either print (print . head) coinList -- @ -- -fetchCoinList :: (MonadIO m, MonadCatch m) => m (Either String [CoinDetails]) -fetchCoinList = catchIOError (do - r <- httpJSON "https://www.cryptocompare.com/api/data/coinlist/" - return . Right . coins $ getResponseBody r) - (return . Left . show) +fetchCoinList :: (MonadIO m) => m (Either String [CoinDetails]) +fetchCoinList = + liftIO $ + E.catch + (do r <- httpJSON "https://www.cryptocompare.com/api/data/coinlist/" + return . Right . coins $ getResponseBody r) + (return . showError) -- | For a given coin, get a daily history of the coin's price -- @@ -277,21 +282,26 @@ -- > print priceHistResp -- fetchDailyPriceHistory :: - (MonadIO m, MonadThrow m, MonadCatch m) + (MonadIO m) => String -- ^ Coin symbol (`BTC`, `ETH`, etc) -> String -- ^ Currency symbol to display prices in (`USD`, `EUR`, etc) -> Integer -- ^ Days of history to return (Max 2000) -> m (Either String PriceHistoryResponse) -- ^ Either an error or response data -fetchDailyPriceHistory coinSymbol priceCurrency days = catchIOError (do - priceHistReq <- - return . parseRequest $ - "https://min-api.cryptocompare.com/data/histoday" ++ - toQueryString - (priceHistReqDefault - {historyFromSym = coinSymbol, historyToSym = priceCurrency, limit = Just days} :: PriceHistoryRequest) - r <- httpJSON <$> priceHistReq - Right . getResponseBody <$> r) - (return . Left . show) +fetchDailyPriceHistory coinSymbol priceCurrency days = + liftIO $ + E.catch + (do priceHistReq <- + return . parseRequest $ + "https://min-api.cryptocompare.com/data/histoday" ++ + toQueryString + (priceHistReqDefault + { historyFromSym = coinSymbol + , historyToSym = priceCurrency + , limit = Just days + } :: PriceHistoryRequest) + r <- httpJSON <$> priceHistReq + Right . getResponseBody <$> r) + (return . showError) -- | For a given coin, get the current price -- @@ -301,18 +311,20 @@ -- > print priceResp -- fetchCurrentPrice :: - (MonadIO m, MonadThrow m, MonadCatch m) - => String -- ^ Coin symbol (`BTC`, `ETH`, etc) - -> [String] -- ^ Currency symbol(s) to display prices in. Eg [`USD`, `EUR`, ...] - -> m (Either String PriceResponse) -- ^ Either an error or response data -fetchCurrentPrice coinSymbol priceSymbols = catchIOError (do - priceReq <- - return . parseRequest $ - "https://min-api.cryptocompare.com/data/price" ++ - toQueryString (PriceRequest coinSymbol priceSymbols) - r <- httpJSON <$> priceReq - Right . getResponseBody <$> r) - (return . Left . show) + MonadIO m + => String -- ^ Coin symbol (`BTC`, `ETH`, etc) + -> [String] -- ^ Currency symbol(s) to display prices in. Eg [`USD`, `EUR`, ...] + -> m (Either String PriceResponse) -- ^ Either an error or response data +fetchCurrentPrice coinSymbol priceSymbols = + liftIO $ + E.catch + (do priceReq <- + return . parseRequest $ + "https://min-api.cryptocompare.com/data/price" ++ + toQueryString (PriceRequest coinSymbol priceSymbols) + r <- httpJSON <$> priceReq + Right . getResponseBody <$> r) + (return . showError) -- | Fetch details about a particular coin -- @@ -320,15 +332,18 @@ -- > snapshotResp <- fetchCoinSnapshot "BTC" "USD" -- > print snapshotResp -- -fetchCoinSnapshot :: (MonadIO m, MonadThrow m, MonadCatch m) +fetchCoinSnapshot :: + MonadIO m => String -- ^ Coin symbol (`BTC`, `ETH`, etc) -> String -- ^ Currency symbol(s) to display prices in (`USD`, `EUR`, etc) -> m (Either String CoinSnapshot) -- ^ Either an error or response data -fetchCoinSnapshot fSym tSym = catchIOError (do - snapshotReq <- - return . parseRequest $ - "https://www.cryptocompare.com/api/data/coinsnapshot" ++ - toQueryString (CoinSnapshotRequest fSym tSym) - r <- httpJSON <$> snapshotReq - Right . snapshot . getResponseBody <$> r) - (return . Left . show) +fetchCoinSnapshot fSym tSym = + liftIO $ + E.catch + (do snapshotReq <- + return . parseRequest $ + "https://www.cryptocompare.com/api/data/coinsnapshot" ++ + toQueryString (CoinSnapshotRequest fSym tSym) + r <- httpJSON <$> snapshotReq + Right . snapshot . getResponseBody <$> r) + (return . showError) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,22 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +import CryptoCompare +import Data.Either +import Data.Either.Utils +import Test.Hspec + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = hspec $ + describe "Testing the library against the live CryptoCompare API" $ + it "performs basic example fetches" $ do + coinList <- fetchCoinList + coinList `shouldSatisfy` isRight + fromRight coinList `shouldSatisfy` (\x -> length x > 1000) + priceResp <- fetchCurrentPrice "BTC" ["USD", "EUR", "BTC"] + priceResp `shouldSatisfy` isRight + priceHistResp <- fetchDailyPriceHistory "BTC" "USD" 300 + priceHistResp `shouldSatisfy` isRight + snapshotResp <- fetchCoinSnapshot "BTC" "USD" + snapshotResp `shouldSatisfy` isRight + +