ally-invest (empty) → 0.1.0.0
raw patch · 13 files changed
+869/−0 lines, 13 filesdep +aesondep +ally-investdep +authenticate-oauthsetup-changed
Dependencies added: aeson, ally-invest, authenticate-oauth, base, bytestring, http-client, http-client-tls, safe, text, time
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +7/−0
- Setup.hs +2/−0
- ally-invest.cabal +74/−0
- src/AllyInvest.hs +13/−0
- src/AllyInvest/Account.hs +200/−0
- src/AllyInvest/Credentials.hs +24/−0
- src/AllyInvest/Error.hs +13/−0
- src/AllyInvest/Internal.hs +41/−0
- src/AllyInvest/Quote.hs +396/−0
- src/AllyInvest/TimeSales.hs +64/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for ally-invest++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Vlad Levenfeld (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,7 @@+# ally-invest++Thin layer over Ally Invest API++An API key from ally.com/invest is required++Currently only timesales per day, quotes and account summary are implemented.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ally-invest.cabal view
@@ -0,0 +1,74 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: a1d64dd3fd2d2ed04a17740ad997a09b067e7cbe9aee1e447796bfed5e6d6b68++name: ally-invest+version: 0.1.0.0+synopsis: Ally Invest integration library+description: Please see the README on GitHub at <https://github.com/evenex/ally-invest#readme>+category: Finance+homepage: https://github.com/evenex/ally-invest#readme+bug-reports: https://github.com/evenex/ally-invest/issues+author: Vlad Levenfeld+maintainer: vlevenfeld@gmail.com+copyright: 2020 Vlad Levenfeld+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/evenex/ally-invest++library+ exposed-modules:+ AllyInvest+ AllyInvest.Account+ AllyInvest.Credentials+ AllyInvest.Error+ AllyInvest.Internal+ AllyInvest.Quote+ AllyInvest.TimeSales+ other-modules:+ Paths_ally_invest+ hs-source-dirs:+ src+ build-depends:+ aeson >=1.4.7 && <1.5+ , authenticate-oauth >=1.6.0 && <1.7+ , base >=4.7 && <5+ , bytestring >=0.10.10 && <0.11+ , http-client >=0.6.4 && <0.7+ , http-client-tls >=0.3.5 && <0.4+ , safe >=0.3.18 && <0.4+ , text >=1.2.4 && <1.3+ , time >=1.9.3 && <1.10+ default-language: Haskell2010++test-suite ally-invest-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_ally_invest+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson >=1.4.7 && <1.5+ , ally-invest+ , authenticate-oauth >=1.6.0 && <1.7+ , base >=4.7 && <5+ , bytestring >=0.10.10 && <0.11+ , http-client >=0.6.4 && <0.7+ , http-client-tls >=0.3.5 && <0.4+ , safe >=0.3.18 && <0.4+ , text >=1.2.4 && <1.3+ , time >=1.9.3 && <1.10+ default-language: Haskell2010
+ src/AllyInvest.hs view
@@ -0,0 +1,13 @@+module AllyInvest (+ module AllyInvest.Account+, module AllyInvest.Credentials+, module AllyInvest.Error+, module AllyInvest.Quote+, module AllyInvest.TimeSales+) where++import AllyInvest.Account+import AllyInvest.Credentials+import AllyInvest.Error+import AllyInvest.Quote+import AllyInvest.TimeSales
+ src/AllyInvest/Account.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE OverloadedStrings #-}++module AllyInvest.Account (+ getAccounts +, AccountSummary(..)+, Balance(..)+, BuyingPower(..)+, MoneyBalance(..)+, SecuritiesBalance(..)+, Holding(..)+, Instrument(..)+, AccountType(..)+) where++import AllyInvest.Credentials+import AllyInvest.Error+import AllyInvest.Internal++import Data.Aeson+import Data.Time++getAccounts :: Credentials -> IO (Either AllyInvestError AccountSummary)+getAccounts cred = fetchAndDecode cred "https://api.tradeking.com/v1/accounts.json"++data AccountSummary+ = AccountSummary {+ aNumber :: Int+ , aBalance :: Balance+ , aHoldings :: [Holding]+ } deriving Show+instance FromJSON AccountSummary+ where+ parseJSON (Object o)+ = let o' = o .: "response" >>= (.: "accounts") >>= (.: "accountsummary")+ in+ AccountSummary+ <$> (fmap read $ o' >>= (.: "account"))+ <*> ( o' >>= (.: "accountbalance"))+ <*> ( o' >>= (.: "accountholdings") >>= (.: "holding"))++data Balance+ = Balance {+ bAccountValue :: Double+ , bBuyingPower :: BuyingPower+ , bFedCall :: Double+ , bHouseCall :: Double+ , bMoney :: MoneyBalance+ , bSecurities :: SecuritiesBalance+ } deriving Show+instance FromJSON Balance+ where+ parseJSON (Object o)+ = Balance+ <$> (read <$> o .: "accountvalue")+ <*> ( o .: "buyingpower")+ <*> (read <$> o .: "fedcall")+ <*> (read <$> o .: "housecall")+ <*> ( o .: "money")+ <*> ( o .: "securities")++data BuyingPower+ = BuyingPower {+ bpCashAvailableForWithdrawal :: Double+ , bpDayTrading :: Double+ , bpEquityPercentage :: Double+ , bpOptions :: Double+ , bpSodDayTrading :: Double+ , bpSodOptions :: Double+ , bpSodStock :: Double+ , bpStock :: Double+ } deriving Show+instance FromJSON BuyingPower+ where+ parseJSON (Object o)+ = BuyingPower+ <$> (read <$> o .: "cashavailableforwithdrawal")+ <*> (read <$> o .: "daytrading")+ <*> (read <$> o .: "equitypercentage")+ <*> (read <$> o .: "options")+ <*> (read <$> o .: "soddaytrading")+ <*> (read <$> o .: "sodoptions")+ <*> (read <$> o .: "sodstock")+ <*> (read <$> o .: "stock")++data MoneyBalance+ = MoneyBalance {+ mbAccruedInterest :: Double+ , mbCash :: Double+ , mbCashAvailable :: Double+ , mbMarginBalance :: Double+ , mbMoneyMarketFund :: Double+ , mbTotal :: Double+ , mbUnclearedDeposits :: Double+ , mbUnsettledFunds :: Double+ , mbYield :: Double+ } deriving Show+instance FromJSON MoneyBalance+ where+ parseJSON (Object o)+ = MoneyBalance+ <$> (read <$> o .: "accruedinterest")+ <*> (read <$> o .: "cash")+ <*> (read <$> o .: "cashavailable")+ <*> (read <$> o .: "marginbalance")+ <*> (read <$> o .: "mmf")+ <*> (read <$> o .: "total")+ <*> (read <$> o .: "uncleareddeposits")+ <*> (read <$> o .: "unsettledfunds")+ <*> (read <$> o .: "yield")++data SecuritiesBalance+ = SecuritiesBalance {+ sbLongOptions :: Double+ , sbLongStocks :: Double+ , sbOptions :: Double+ , sbShortOptions :: Double+ , sbShortStocks :: Double+ , sbStocks :: Double+ , sbTotal :: Double+ } deriving Show+instance FromJSON SecuritiesBalance+ where+ parseJSON (Object o)+ = SecuritiesBalance+ <$> (read <$> o .: "longoptions")+ <*> (read <$> o .: "longstocks")+ <*> (read <$> o .: "options")+ <*> (read <$> o .: "shortoptions")+ <*> (read <$> o .: "shortstocks")+ <*> (read <$> o .: "stocks")+ <*> (read <$> o .: "total")++data Holding+ = Holding {+ hAccountType :: AccountType+ , hCostBasis :: Double+ , hGainLoss :: Double+ , hInstrument :: Instrument+ , hMarketValue :: Double+ , hMarketValueChange :: Double+ , hPrice :: Double+ , hPurchasePrice :: Double+ , hQuantity :: Double+ , hQuoteChange :: Double+ , hQuoteLastPrice :: Double+ } deriving Show+instance FromJSON Holding+ where+ parseJSON (Object o)+ = Holding+ <$> ( o .: "accounttype")+ <*> (read <$> o .: "costbasis")+ <*> (read <$> o .: "gainloss")+ <*> ( o .: "instrument")+ <*> (read <$> o .: "marketvalue")+ <*> (read <$> o .: "marketvaluechange")+ <*> (read <$> o .: "price")+ <*> (read <$> o .: "purchaseprice")+ <*> (read <$> o .: "qty")+ <*> (read <$> (o .: "quote" >>= (.: "change")))+ <*> (read <$> (o .: "quote" >>= (.: "lastprice")))++data Instrument+ = Instrument {+ iCusip :: String+ , iDesc :: String+ , iFactor :: Double+ , iMaturityDate :: ZonedTime+ , iMaturityMonthYear :: Maybe String+ , iMultiplier :: Double+ , iPutOrCall :: String+ , iSecurityType :: String+ , iStrikePrice :: Double+ , iSymbol :: String+ } deriving Show+instance FromJSON Instrument+ where+ parseJSON (Object o)+ = Instrument+ <$> ( o .: "cusip")+ <*> ( o .: "desc")+ <*> (read <$> o .: "factor")+ <*> ( o .: "matdt")+ <*> ( o .: "mmy")+ <*> (read <$> o .: "mult")+ <*> ( o .: "putcall")+ <*> ( o .: "sectyp")+ <*> (read <$> o .: "strkpx")+ <*> ( o .: "sym")++data AccountType = CashAccount | MarginLongAccount | MarginShortAccount+ deriving Show+instance FromJSON AccountType where+ parseJSON v = case (fromJSON v :: Result String) of+ Error err -> fail err+ Success t -> case t of+ "1" -> return CashAccount+ "2" -> return MarginLongAccount+ "5" -> return MarginShortAccount+ _ -> fail "bad accounttype enum"
+ src/AllyInvest/Credentials.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module AllyInvest.Credentials (+ Credentials(..)+) where++import Data.Aeson+import qualified Data.ByteString.Char8 as S8++data Credentials+ = Credentials {+ consumerKey :: S8.ByteString+ , consumerSecret :: S8.ByteString+ , oAuthToken :: S8.ByteString+ , oAuthTokenSecret :: S8.ByteString+ }+instance FromJSON Credentials+ where+ parseJSON (Object o)+ = Credentials+ <$> (S8.pack <$> o .: "consumer_key")+ <*> (S8.pack <$> o .: "consumer_secret")+ <*> (S8.pack <$> o .: "oauth_token")+ <*> (S8.pack <$> o .: "oauth_token_secret")
+ src/AllyInvest/Error.hs view
@@ -0,0 +1,13 @@+module AllyInvest.Error (+ AllyInvestError(..)+, Pending+) where++import Network.HTTP.Client++data AllyInvestError+ = NetworkError HttpException+ | DecodeFailed String+ deriving Show++type Pending = String
+ src/AllyInvest/Internal.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+++module AllyInvest.Internal (+ signRequest+, boxException+, fetchAndDecode+) where++import AllyInvest.Credentials+import AllyInvest.Error++import qualified Network.HTTP.Client.TLS as HTTPS+import Network.HTTP.Client+import Web.Authenticate.OAuth++import Data.Aeson++import Control.Exception++signRequest :: Credentials -> String -> IO Request+signRequest (Credentials {..}) url+ = do+ initReq <- parseRequest url+ let req = initReq { method = "GET" }+ let oAuth = def { oauthConsumerKey = consumerKey, oauthConsumerSecret = consumerSecret }+ let cred = newCredential oAuthToken oAuthTokenSecret+ signOAuth oAuth cred req++boxException :: (e -> AllyInvestError) -> Either e a -> Either AllyInvestError a+boxException fBox (Left e) = Left $ fBox e+boxException _ (Right x) = Right x++fetchAndDecode :: FromJSON a => Credentials -> String -> IO (Either AllyInvestError a)+fetchAndDecode cred url+ = do+ req <- signRequest cred url+ mgr <- HTTPS.newTlsManager+ res <- try $ httpLbs req mgr+ return $ boxException NetworkError res+ >>= boxException DecodeFailed . eitherDecode . responseBody
+ src/AllyInvest/Quote.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE OverloadedStrings #-}++module AllyInvest.Quote (+ getQuotes +, TradeConditionCode(..)+, TradingSession(..)+, DividendFrequency(..)+, OptionDelivery(..)+, OptionStyle(..)+, OptionClass(..)+, OptionType(..)+, Quote(..)+) where++import AllyInvest.Credentials+import AllyInvest.Error+import AllyInvest.Internal++import Safe++import Data.Aeson+import qualified Data.Text as T+import Data.List++getQuotes :: Credentials -> [String] -> IO (Either AllyInvestError [Quote])+getQuotes cred syms + = if length syms > 1+ then fmap unQuotesResult <$> fetchAndDecode cred url+ else fmap (return . unQuoteResult) <$> fetchAndDecode cred url+ where+ url = "https://api.tradeking.com/v1/market/ext/quotes.json?symbols=" ++ intercalate "," syms+ +data TradeConditionCode = TradeHalted | TradeResumed | TradeConditionUnknown String+ deriving Show+instance FromJSON TradeConditionCode where+ parseJSON (String "H") = return TradeHalted+ parseJSON (String "R") = return TradeResumed+ parseJSON (String x) = return . TradeConditionUnknown . T.unpack $ x+ parseJSON x = fail (show x)++data TradingSession = PremarketSession | RegularSession | PostmarketSession | MarketClosed+ deriving Show+instance FromJSON TradingSession where+ parseJSON (String "pre") = return PremarketSession+ parseJSON (String "regular") = return RegularSession+ parseJSON (String "post") = return PostmarketSession+ parseJSON (String "na") = return MarketClosed+ parseJSON x = fail (show x)++data DividendFrequency = AnnualDividend | SemiAnnualDividend | QuarterlyDividend | MonthlyDividend | NoDividend+ deriving Show+instance FromJSON DividendFrequency where+ parseJSON (String "A") = return AnnualDividend + parseJSON (String "S") = return SemiAnnualDividend + parseJSON (String "Q") = return QuarterlyDividend + parseJSON (String "M") = return MonthlyDividend + parseJSON (String "N") = return NoDividend+ parseJSON x = fail (show x)++data OptionDelivery = StandardSettlement | NonstandardSettlement | NoSettlement+ deriving Show+instance FromJSON OptionDelivery where+ parseJSON (String "S") = return StandardSettlement + parseJSON (String "N") = return NonstandardSettlement + parseJSON (String "X") = return NoSettlement+ parseJSON x = fail (show x)++data OptionStyle = AmericanOption | EuropeanOption+ deriving Show+instance FromJSON OptionStyle where+ parseJSON (String "A") = return AmericanOption + parseJSON (String "E") = return EuropeanOption+ parseJSON x = fail (show x)++data OptionClass = StandardOption | LeapOption | ShortTermOption+ deriving Show+instance FromJSON OptionClass where+ parseJSON (String "0") = return StandardOption + parseJSON (String "1") = return LeapOption + parseJSON (String "3") = return ShortTermOption+ parseJSON x = fail (show x)++data OptionType = PutOption | CallOption+ deriving Show+instance FromJSON OptionType where+ parseJSON (String "Put") = return PutOption + parseJSON (String "Call") = return CallOption + parseJSON x = fail (show x)++data Quote+ = StockQuote {+ sqAskPrice :: Double+ , sqLatestAskSize :: Int+ , sqLatestAskTime :: Pending+ , sqReportedPrecision :: Maybe Int+ , sqBidPrice :: Double+ , sqLatestBidSize :: Int+ , sqLatestBidTime :: Pending+ , sqChangeSincePriorDayClose :: Pending+ , sqChangeSign :: Maybe Ordering+ , sqChangeText :: Maybe String+ , sqPreviousClose :: Double+ , sqDateTime :: Pending+ , sqLastTradeDate :: Pending+ , sqTotalValueTradedToday :: Double+ , sqExchangeDescription :: String+ , sqExchangeCode :: Pending+ , sqTodayHighTradePrice :: Double+ , sqLastTradeVolume :: Int+ , sqLastTradePrice :: Double+ , sqTodayLowTradePrice :: Double+ , sqCompanyName :: String+ , sqOpenTradePrice :: Double+ , sqPercentageChangeFromPriorDayClose :: Double+ , sqPercentageChangeSign :: Maybe Ordering+ , sqPriorDayClose :: Double+ , sqPriorDayHighTradePrice :: Double+ , sqPriorDayLowTradePrice :: Double+ , sqPriorDayOpenPrice :: Double+ , sqPriorDayPriceChange :: Double+ , sqPriorLastTradeDate :: Pending+ , sqPriorDayTotalVolume :: Int+ , sqSecurityIsOption :: Bool+ , sqTradingSession :: TradingSession+ , sqSymbol :: String+ , sqTradeConditionCode :: TradeConditionCode+ , sqTimestamp :: Pending+ , sqTickDirFromPriorTrade :: Ordering+ , sqTrendBasedOn10PriorTicks :: Maybe Ordering+ , sqNumTradesSinceMarketOpen :: Int+ , sqCumulativeVolume :: Int+ , sqVolumeWeightedAveragePrice :: Double+ , sq52WeekHigh :: Double+ , sq52WeekHighDate :: Pending+ , sq52WeekLow :: Double+ , sq52WeekLowDate :: Pending+ , sq100DayAveragePrice :: Double+ , sq200DayAveragePrice :: Double+ , sq50DayAveragePrice :: Double+ , sq21DayAverageVolume :: Int+ , sq30DayAverageVolume :: Int+ , sq90DaysAverageVolume :: Int+ , sqBeta :: Double+ , sqTickDirSinceLastBid :: Ordering+ , sqCusip :: Maybe String+ , sqExDividendDate :: Pending+ , sqDividendFrequency :: DividendFrequency+ , sqLatestAnnouncedCashDividend :: Double+ , sqLastAnnouncedDividendPayDate :: Pending+ , sqEarningsPerShare :: Double+ , sqIndicatedAnnualDividend :: Pending+ , sqSecurityHasOptions :: Bool+ , sqPriceEarningsRatio :: Double+ , sqPrior100DayAveragePrice :: Double+ , sqPrior200DayAveragePrice :: Double+ , sqPrior50DayAveragePrice :: Double+ , sqBookValuePrice :: Double+ , sqSharesOutstanding :: Int+ , sqOneYearVolatilityMeasure :: Double+ , sqDividendYield :: Double+ }+ | OptionQuote {+ oqAskPrice :: Double+ , oqLatestAskSize :: Int+ , oqLatestAskTime :: Pending+ , oqReportedPrecision :: Maybe Int+ , oqBidPrice :: Double+ , oqLatestBidSize :: Int+ , oqLatestBidTime :: Pending+ , oqChangeSincePriorDayClose :: Pending+ , oqChangeSign :: Maybe Ordering+ , oqChangeText :: Maybe String+ , oqPreviousClose :: Double+ , oqDateTime :: Pending+ , oqLastTradeDate :: Pending+ , oqTotalValueTradedToday :: Double+ , oqExchangeDescription :: String+ , oqExchangeCode :: Pending+ , oqTodayHighTradePrice :: Double+ , oqLastTradeVolume :: Int+ , oqLastTradePrice :: Double+ , oqTodayLowTradePrice :: Double+ , oqCompanyName :: String+ , oqOpenTradePrice :: Double+ , oqPercentageChangeFromPriorDayClose :: Double+ , oqPercentageChangeSign :: Maybe Ordering+ , oqPriorDayClose :: Double+ , oqPriorDayHighTradePrice :: Double+ , oqPriorDayLowTradePrice :: Double+ , oqPriorDayOpenPrice :: Double+ , oqPriorDayPriceChange :: Double+ , oqPriorLastTradeDate :: Pending+ , oqPriorDayTotalVolume :: Int+ , oqSecurityIsOption :: Bool+ , oqTradingSession :: TradingSession+ , oqSymbol :: String+ , oqTradeConditionCode :: TradeConditionCode+ , oqTimestamp :: Pending+ , oqTickDirFromPriorTrade :: Ordering+ , oqTrendBasedOn10PriorTicks :: Maybe Ordering+ , oqNumTradesSinceMarketOpen :: Int+ , oqCumulativeVolume :: Int+ , oqVolumeWeightedAveragePrice :: Double+ , oq52WeekHigh :: Double+ , oq52WeekHighDate :: Pending+ , oq52WeekLow :: Double+ , oq52WeekLowDate :: Pending+ , oqContractSize :: Int+ , oqDaysUntilExpiration :: Int+ , oqImpliedVolatilityDelta :: Double+ , oqImpliedVolatilityGamma :: Double+ , oqImpliedVolatilityPrice :: Double+ , oqImpliedVolatilityRho :: Double+ , oqIssueDescription :: String+ , oqImpliedVolatilityTheta :: Double+ , oqImpliedVolatilityVega :: Double+ , oqSettlementDesignation :: OptionDelivery+ , oqOpenInterest :: Double+ , oqOptionStyle :: OptionStyle+ , oqOptionClass :: OptionClass+ , oqEstimatedOptionValue :: Double -- via Ju/Zhong or Black-Scholes+ , oqPremiumMultiplier :: Double+ , oqPriorDayOpenInterest :: Double+ , oqOptionType :: OptionType+ , oqConditionCode :: String+ , oqRootSymbol :: String+ , oqStrikePrice :: Double+ , oqUnderlyingCusip :: String+ , oqUnderlyingSymbol :: String+ , oqExpirationDate :: Pending+ , oqExpirationDay :: Pending+ , oqExpirationMonth :: Pending+ , oqExpirationYear :: Pending+ }+ deriving Show++toOrd :: String -> Ordering+toOrd "u" = GT+toOrd "e" = EQ+toOrd "d" = LT++toOrdMay :: String -> Maybe Ordering+toOrdMay "na" = Nothing+toOrdMay x = Just $ toOrd x++toBool :: String -> Bool+toBool "0" = False+toBool "1" = True++toStrMay :: String -> Maybe String+toStrMay "na" = Nothing+toStrMay x = Just x++instance FromJSON Quote where+ parseJSON (Object o)+ = do+ askPrice <- read <$> o .: "ask"+ latestAskSize <- (*100) . read <$> o .: "asksz"+ latestAskTime <- o .: "ask_time"+ reportedPrecision <- readMay <$> o .: "basis"+ bidPrice <- read <$> o .: "bid"+ latestBidSize <- (*100) . read <$> o .: "bidsz"+ latestBidTime <- o .: "bid_time"+ changeSincePriorDayClose <- o .: "chg"+ changeSign <- toOrdMay <$> o .: "chg_sign"+ changeText <- toStrMay<$> o .: "chg_t"+ previousClose <- read <$> o .: "cl"+ dateTime <- o .: "datetime"+ lastTradeDate <- o .: "date"+ totalValueTradedToday <- read <$> o .: "dollar_value"+ exchangeDescription <- o .: "exch_desc"+ exchangeCode <- o .: "exch"+ todayHighTradePrice <- read <$> o .: "hi"+ lastTradeVolume <- read <$> o .: "incr_vl"+ lastTradePrice <- read <$> o .: "last"+ todayLowTradePrice <- read <$> o .: "lo"+ companyName <- o .: "name"+ openTradePrice <- read <$> o .: "opn"+ percentageChangeFromPriorDayClose <- read <$> o .: "pchg"+ percentageChangeSign <- toOrdMay <$> o .: "pchg_sign"+ priorDayClose <- read <$> o .: "pcls"+ priorDayHighTradePrice <- read <$> o .: "phi"+ priorDayLowTradePrice <- read <$> o .: "plo"+ priorDayOpenPrice <- read <$> o .: "popn"+ priorDayPriceChange <- read <$> o .: "prchg"+ priorLastTradeDate <- o .: "pr_date"+ priorDayTotalVolume <- read <$> o .: "pvol"+ securityIsOption <- toBool <$> o .: "secclass"+ tradingSession <- o .: "sesn"+ symbol <- o .: "symbol"+ tradeConditionCode <- o .: "tcond"+ timestamp <- o .: "timestamp"+ tickDirFromPriorTrade <- toOrd <$> o .: "tradetick"+ trendBasedOn10PriorTicks <- toOrdMay <$> o .: "trend"+ numTradesSinceMarketOpen <- read <$> o .: "tr_num"+ cumulativeVolume <- read <$> o .: "vl"+ volumeWeightedAveragePrice <- read <$> o .: "vwap"+ week52High <- read <$> o .: "wk52hi"+ week52HighDate <- o .: "wk52hidate"+ week52Low <- read <$> o .: "wk52lo"+ week52LowDate <- o .: "wk52lodate"+ if securityIsOption+ then OptionQuote+ askPrice latestAskSize latestAskTime reportedPrecision bidPrice+ latestBidSize latestBidTime changeSincePriorDayClose changeSign changeText+ previousClose dateTime lastTradeDate totalValueTradedToday exchangeDescription+ exchangeCode todayHighTradePrice lastTradeVolume lastTradePrice todayLowTradePrice+ companyName openTradePrice percentageChangeFromPriorDayClose percentageChangeSign priorDayClose+ priorDayHighTradePrice priorDayLowTradePrice priorDayOpenPrice priorDayPriceChange priorLastTradeDate+ priorDayTotalVolume securityIsOption tradingSession symbol tradeConditionCode+ timestamp tickDirFromPriorTrade trendBasedOn10PriorTicks numTradesSinceMarketOpen cumulativeVolume+ volumeWeightedAveragePrice week52High week52HighDate week52Low week52LowDate+ <$> (read <$> o .: "contract_size")+ <*> (read <$> o .: "days_to_expiration")+ <*> (read <$> o .: "idelta")+ <*> (read <$> o .: "igamma")+ <*> (read <$> o .: "imp_volatility")+ <*> (read <$> o .: "irho")+ <*> (read <$> o .: "issue_desc")+ <*> (read <$> o .: "itheta")+ <*> (read <$> o .: "ivega")+ <*> ( o .: "op_delivery")+ <*> (read <$> o .: "openinterest")+ <*> ( o .: "op_style")+ <*> ( o .: "op_subclass")+ <*> (read <$> o .: "opt_val")+ <*> (read <$> o .: "prem_mult")+ <*> (read <$> o .: "pr_openinterest")+ <*> ( o .: "put_call")+ <*> (read <$> o .: "qcond")+ <*> (read <$> o .: "rootsymbol")+ <*> (read <$> o .: "strikeprice")+ <*> (read <$> o .: "under_cusip")+ <*> (read <$> o .: "undersymbol")+ <*> (read <$> o .: "xdate")+ <*> (read <$> o .: "xday")+ <*> (read <$> o .: "xmonth")+ <*> (read <$> o .: "xyear")+ else StockQuote+ askPrice latestAskSize latestAskTime reportedPrecision bidPrice+ latestBidSize latestBidTime changeSincePriorDayClose changeSign changeText+ previousClose dateTime lastTradeDate totalValueTradedToday exchangeDescription+ exchangeCode todayHighTradePrice lastTradeVolume lastTradePrice todayLowTradePrice+ companyName openTradePrice percentageChangeFromPriorDayClose percentageChangeSign priorDayClose+ priorDayHighTradePrice priorDayLowTradePrice priorDayOpenPrice priorDayPriceChange priorLastTradeDate+ priorDayTotalVolume securityIsOption tradingSession symbol tradeConditionCode+ timestamp tickDirFromPriorTrade trendBasedOn10PriorTicks numTradesSinceMarketOpen cumulativeVolume+ volumeWeightedAveragePrice week52High week52HighDate week52Low week52LowDate+ <$> (read <$> o .: "adp_100")+ <*> (read <$> o .: "adp_200")+ <*> (read <$> o .: "adp_50")+ <*> (read <$> o .: "adv_21")+ <*> (read <$> o .: "adv_30")+ <*> (read <$> o .: "adv_90")+ <*> (read <$> o .: "beta")+ <*> (toOrd<$> o .: "bidtick")+ <*> (toStrMay<$> o .: "cusip")+ <*> ( o .: "divexdate")+ <*> ( o .: "divfreq")+ <*> (read <$> o .: "div")+ <*> ( o .: "divpaydt")+ <*> (read <$> o .: "eps")+ <*> ( o .: "iad")+ <*> (toBool<$>o .: "op_flag")+ <*> (read <$> o .: "pe")+ <*> (read <$> o .: "pr_adp_100")+ <*> (read <$> o .: "pr_adp_200")+ <*> (read <$> o .: "pr_adp_50")+ <*> (read <$> o .: "prbook")+ <*> (read <$> o .: "sho")+ <*> (read <$> o .: "volatility12")+ <*> (read <$> o .: "yield")+ parseJSON x = fail . show $ x++--------------------------------------------------------------------------------+-- INTERNAL+--------------------------------------------------------------------------------++data QuoteResult+ = QuoteResult {+ unQuoteResult :: Quote+ }+instance FromJSON QuoteResult+ where+ parseJSON (Object o)+ = QuoteResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote"))++data QuotesResult+ = QuotesResult {+ unQuotesResult :: [Quote]+ }+instance FromJSON QuotesResult+ where+ parseJSON (Object o)+ = QuotesResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote"))+
+ src/AllyInvest/TimeSales.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}++module AllyInvest.TimeSales (+ getTimeSales +, Candle(..)+) where++import AllyInvest.Credentials+import AllyInvest.Error+import AllyInvest.Internal++import Data.Aeson+import Data.Time+import Data.List++getTimeSales :: Credentials -> String -> Day -> IO (Either AllyInvestError [Candle])+getTimeSales cred sym day+ = fmap unCandleResult <$> fetchAndDecode cred url+ where+ url = intercalate "?" [+ "https://api.tradeking.com/v1/market/timesales.json"+ , intercalate "&"+ . fmap (\(x,y) -> intercalate "=" [x, y])+ $ [ ("symbols", sym)+ , ("startdate", show day)+ , ("enddate", show $ addDays 1 day)+ ]+ ]++data Candle+ = Candle {+ tDate :: Day+ , tDateTime :: UTCTime+ , tLowPrice :: Double+ , tHighPrice :: Double+ , tOpenPrice :: Double+ , tLastPrice :: Double+ , tTradeVolume :: Int+ , tCumulativeTradeVolume :: Int+ } deriving Show+instance FromJSON Candle+ where+ parseJSON (Object o)+ = Candle+ <$> (o .: "date")+ <*> (o .: "datetime")+ <*> (read <$> o .: "lo")+ <*> (read <$> o .: "hi")+ <*> (read <$> o .: "opn")+ <*> (read <$> o .: "last")+ <*> (read <$> o .: "incr_vl")+ <*> (read <$> o .: "vl")++--------------------------------------------------------------------------------+-- private+--------------------------------------------------------------------------------+data CandleResult+ = CandleResult {+ unCandleResult :: [Candle]+ }+instance FromJSON CandleResult+ where+ parseJSON (Object o)+ = CandleResult <$> (o .: "response" >>= (.: "quotes") >>= (.: "quote"))
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"