diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,31 @@ ## master + +## v0.1.3.0 + +* Change `Prices` volume field from `Integer` to `Scientific` to support + decimal amounts returned by cryptocurrency routes. +* AlphaVantage changed the information message field from `Note` to + `Information` so we now attempt to parse both and throw an `ApiError` if + either exist. This usually occurs when you've run out of API calls for the + day. +* AlphaVantage changed the `DIGITAL_CURRENCY_DAILY` endpoint to return the same + price fields as the `TIME_SERIES_DAILY` endpoint, so we dropped the + `CryptoPrices` type and return the `Prices` type from both the stock & crypto + API calls. +* AlphaVantage has swapped premium-only endpoints on us again - now + `TIME_SERIES_DAILY` is free and `TIME_SERIES_DAILY_ADJUSTED` is paid-only so + we had to switch back. + + +## v0.1.2.2 + +* Switch from the (now premium-only) `TIME_SERIES_DAILY` AlphaVantage endpoint + to the free `TIME_SERIES_DAILY_ADJUSTED` endpoint. +* Bump package dependencies. + + ## v0.1.2.1 * Fix breaking changes in `hledger-lib` v1.26. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -44,9 +44,9 @@ ### Excluding Commodities By default, we query AlphaVantage for all non-USD commodities included in your -journal file. We do not currently support AlphaVantage's FOREX or Crypto API -routes, so if you have those commodities, `stockquotes` will print an error -when fetching them. You can exclude commodities by passing them as arguments to +journal file. We do not currently support AlphaVantage's FOREX API route, so if +you have those commodities, `stockquotes` will print an error when fetching +them. You can exclude commodities by passing them as arguments to `hledger-stockquotes`: ```sh @@ -88,21 +88,51 @@ `$XDG_CONFIG_HOME/hledger-stockquotes/config.yaml`(`$XDG_CONFIG_HOME` is usually `~/.config/`). -You can set the `api-key`, `rate-limit`, `cryptocurrencies`, & `exclude` -options via this file: +You can set the `api-key`, `rate-limit`, `cryptocurrencies`, `exclude`, & +`commodity-aliases` options via this file: ```yaml rate-limit: false api-key: DeAdBeEf9001 -crypto-currencies: +cryptocurrencies: - BTC - XMR exclude: - USD - AUTO +commodity-aliases: + MY_BTC_CURRENCY: BTC + 401K_VTSAX: VTSAX ``` CLI flags & environmental variables will override config file settings. + + +### Aliases + +By specifying the `commedity-aliases` option in your configuration file, +you can rename the commodities used in your journal to the commodities +expected by AlphaVantage. + +Keys in the map should be your journal commities while their values are the +AlphaVantage ticker symbols: + +```yaml +commodity-aliases: + MY_VTSAX: VTSAX + MY_BTC_CURRENCY: BTC +``` + +Renaming is done after commodity exclusion, but before bucketing them into +equities & cryptocurrencies so the `exclude` list should use your symbols while +the `cryptocurrencies` list should use AlphaVantage's: + +```code +journal -> exclude -> commodity-aliases -> cryptocurrencies +``` + +Specifying aliases via command line options or environmental variable +is not currently supported. ### Additional Documentation diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ import Distribution.Simple + + main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,95 +1,109 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} + module Main where -import Control.Applicative ( (<|>) ) -import Control.Exception.Safe ( try ) -import Control.Monad ( forM_ ) -import Data.Aeson ( (.:?) - , FromJSON(..) - , withObject - ) -import Data.List ( partition ) -import Data.Maybe ( fromMaybe ) -import Data.Time ( Day - , defaultTimeLocale - , formatTime - ) -import Data.Version ( showVersion ) -import Data.Yaml ( prettyPrintParseException ) -import Data.Yaml.Config ( ignoreEnv - , loadYamlSettings - ) -import System.Console.CmdArgs ( (&=) - , Data - , Typeable - , args - , cmdArgs - , details - , enum - , explicit - , help - , helpArg - , ignore - , name - , program - , summary - , typ - ) -import System.Directory ( doesFileExist ) -import System.Environment ( lookupEnv ) -import System.Environment.XDG.BaseDir ( getUserConfigFile ) -import System.Exit ( exitFailure ) -import System.IO ( hPutStrLn - , stderr - ) -import Text.RawString.QQ ( r ) +import Control.Applicative ((<|>)) +import Control.Exception.Safe (try) +import Control.Monad (forM_) +import Data.Aeson + ( FromJSON (..) + , withObject + , (.:?) + ) +import Data.Maybe (fromMaybe) +import Data.Time + ( Day + , defaultTimeLocale + , formatTime + ) +import Data.Version (showVersion) +import Data.Yaml (prettyPrintParseException) +import Data.Yaml.Config + ( ignoreEnv + , loadYamlSettings + ) +import System.Console.CmdArgs + ( Data + , Typeable + , args + , cmdArgs + , details + , enum + , explicit + , help + , helpArg + , ignore + , name + , program + , summary + , typ + , (&=) + ) +import System.Directory (doesFileExist) +import System.Environment (lookupEnv) +import System.Environment.XDG.BaseDir (getUserConfigFile) +import System.Exit (exitFailure) +import System.IO + ( hPutStrLn + , stderr + ) +import Text.RawString.QQ (r) -import Hledger.StockQuotes -import Paths_hledger_stockquotes ( version ) -import Web.AlphaVantage +import Hledger.StockQuotes +import Paths_hledger_stockquotes (version) +import Web.AlphaVantage -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map as M +import qualified Data.Text as T main :: IO () main = do - cfgArgs <- cmdArgs argSpec - cfgFile <- loadConfigFile + cfgArgs <- cmdArgs argSpec + cfgFile <- loadConfigFile AppConfig {..} <- mergeArgsEnvCfg cfgFile cfgArgs let cfg = Config $ T.pack apiKey - (commodities, start, end) <- getCommoditiesAndDateRange - (T.pack <$> excludedCurrencies) - journalFile + (commodities, start, end) <- + getCommoditiesAndDateRange + (T.pack <$> excludedCurrencies) + journalFile if not dryRun then do - prices <- fetchPrices cfg - commodities - cryptoCurrencies - start - end - rateLimit + prices <- + fetchPrices + cfg + commodities + cryptoCurrencies + aliases + start + end + rateLimit if null prices then logError "No price directives were able to be fetched." else LBS.writeFile outputFile $ makePriceDirectives prices else do - putStrLn - $ "Querying from " - <> showDate start - <> " to " - <> showDate end + putStrLn $ + "Querying from " + <> showDate start + <> " to " + <> showDate end let (stocks, cryptos) = - partition (`notElem` cryptoCurrencies) commodities + unaliasAndBucketCommodities commodities cryptoCurrencies aliases putStrLn "Querying Stocks:" forM_ stocks $ \commodity -> putStrLn $ "\t" <> T.unpack commodity putStrLn "Querying CryptoCurrencies:" forM_ cryptos $ \commodity -> putStrLn $ "\t" <> T.unpack commodity + let reAliased = map fst $ reAliasCommodities (fmap (,()) $ stocks <> cryptos) commodities aliases + putStrLn "Writing Prices for:" + forM_ reAliased $ \commodity -> putStrLn $ "\t" <> T.unpack commodity where showDate :: Day -> String showDate = formatTime defaultTimeLocale "%Y-%m-%d" @@ -99,23 +113,25 @@ logError = hPutStrLn stderr . ("[ERROR] " <>) - -- CONFIGURATION data AppConfig = AppConfig - { apiKey :: String - , rateLimit :: Bool - , journalFile :: FilePath - , outputFile :: FilePath + { apiKey :: String + , rateLimit :: Bool + , journalFile :: FilePath + , outputFile :: FilePath , excludedCurrencies :: [String] - , cryptoCurrencies :: [T.Text] - , dryRun :: Bool + , cryptoCurrencies :: [T.Text] + , dryRun :: Bool + , aliases :: M.Map T.Text T.Text } deriving (Show, Eq) + defaultExcludedCurrencies :: [String] defaultExcludedCurrencies = ["$", "USD"] + -- | Merge the Arguments, Environmental Variables, & Configuration File -- into an 'AppConfig. -- @@ -124,12 +140,12 @@ mergeArgsEnvCfg :: ConfigFile -> Args -> IO AppConfig mergeArgsEnvCfg ConfigFile {..} Args {..} = do envJournalFile <- lookupEnv "LEDGER_FILE" - envApiKey <- lookupEnv "ALPHAVANTAGE_KEY" - apiKey <- case argApiKey <|> envApiKey <|> cfgApiKey of + envApiKey <- lookupEnv "ALPHAVANTAGE_KEY" + apiKey <- case argApiKey <|> envApiKey <|> cfgApiKey of Just k -> return k Nothing -> logError - "Pass an AlphaVantage API Key with `-a` or $ALPHAVANTAGE_KEY." + "Pass an AlphaVantage API Key with `-a` or $ALPHAVANTAGE_KEY." >> exitFailure let journalFile = fromMaybe "~/.hledger.journal" $ argJournalFile <|> envJournalFile @@ -139,119 +155,134 @@ if argExcludedCurrencies == defaultExcludedCurrencies then fromMaybe defaultExcludedCurrencies cfgExcludedCurrencies else argExcludedCurrencies - cryptoCurrencies = if null argCryptoCurrencies - then maybe [] (map T.pack) cfgCryptoCurrencies - else concatMap (T.splitOn "," . T.pack) argCryptoCurrencies + cryptoCurrencies = + if null argCryptoCurrencies + then maybe [] (map T.pack) cfgCryptoCurrencies + else concatMap (T.splitOn "," . T.pack) argCryptoCurrencies outputFile = argOutputFile - dryRun = argDryRun - return AppConfig { .. } + dryRun = argDryRun + aliases = fromMaybe M.empty cfgAliases + return AppConfig {..} data ConfigFile = ConfigFile - { cfgApiKey :: Maybe String - , cfgRateLimit :: Maybe Bool + { cfgApiKey :: Maybe String + , cfgRateLimit :: Maybe Bool , cfgExcludedCurrencies :: Maybe [String] - , cfgCryptoCurrencies :: Maybe [String] + , cfgCryptoCurrencies :: Maybe [String] + , cfgAliases :: Maybe (M.Map T.Text T.Text) } deriving (Show, Eq) + instance FromJSON ConfigFile where parseJSON = withObject "ConfigFile" $ \o -> do - cfgApiKey <- o .:? "api-key" - cfgRateLimit <- o .:? "rate-limit" + cfgApiKey <- o .:? "api-key" + cfgRateLimit <- o .:? "rate-limit" cfgExcludedCurrencies <- o .:? "exclude" - cfgCryptoCurrencies <- o .:? "cryptocurrencies" - return ConfigFile { .. } + cfgCryptoCurrencies <- o .:? "cryptocurrencies" + cfgAliases <- o .:? "commodity-aliases" + return ConfigFile {..} + loadConfigFile :: IO ConfigFile loadConfigFile = do configFile <- getUserConfigFile "hledger-stockquotes" "config.yaml" - hasConfig <- doesFileExist configFile + hasConfig <- doesFileExist configFile if hasConfig - then try (loadYamlSettings [configFile] [] ignoreEnv) >>= \case - Left (lines . prettyPrintParseException -> errorMsg) -> - hPutStrLn stderr "[WARN] Invalid Configuration File Format:" - >> mapM_ (hPutStrLn stderr . ("\t" <>)) errorMsg - >> return defaultConfig - Right c -> return c + then + try (loadYamlSettings [configFile] [] ignoreEnv) >>= \case + Left (lines . prettyPrintParseException -> errorMsg) -> + hPutStrLn stderr "[WARN] Invalid Configuration File Format:" + >> mapM_ (hPutStrLn stderr . ("\t" <>)) errorMsg + >> return defaultConfig + Right c -> return c else return defaultConfig where defaultConfig :: ConfigFile - defaultConfig = ConfigFile Nothing Nothing Nothing Nothing - + defaultConfig = ConfigFile Nothing Nothing Nothing Nothing Nothing data Args = Args - { argApiKey :: Maybe String - , argRateLimit :: Either () Bool - , argJournalFile :: Maybe FilePath - , argOutputFile :: FilePath + { argApiKey :: Maybe String + , argRateLimit :: Either () Bool + , argJournalFile :: Maybe FilePath + , argOutputFile :: FilePath , argExcludedCurrencies :: [String] - , argCryptoCurrencies :: [String] - , argDryRun :: Bool + , argCryptoCurrencies :: [String] + , argDryRun :: Bool } deriving (Data, Typeable, Show, Eq) + argSpec :: Args argSpec = Args - { argApiKey = - Nothing + { argApiKey = + Nothing &= help "Your AlphaVantage API key. Default: $ALPHAVANTAGE_KEY" &= explicit &= name "api-key" &= name "a" &= typ "ALPHAVANTAGE_KEY" - , argRateLimit = enum + , argRateLimit = + enum [ Left () - &= help "Fall back to the configuration file, or True." - &= ignore + &= help "Fall back to the configuration file, or True." + &= ignore , Right True - &= help "Apply rate-limting for the API" - &= explicit - &= name "rate-limit" - &= name "r" + &= help "Apply rate-limting for the API" + &= explicit + &= name "rate-limit" + &= name "r" , Right False - &= help "Disable rate-limiting for the API" - &= explicit - &= name "no-rate-limit" - &= name "n" + &= help "Disable rate-limiting for the API" + &= explicit + &= name "no-rate-limit" + &= name "n" ] - , argJournalFile = - Nothing + , argJournalFile = + Nothing &= help - "Journal file to read commodities from. Default: $LEDGER_FILE or ~/.hledger.journal" + "Journal file to read commodities from. Default: $LEDGER_FILE or ~/.hledger.journal" &= explicit &= name "journal-file" &= name "f" &= typ "FILE" - , argOutputFile = - "prices.journal" + , argOutputFile = + "prices.journal" &= help - "File to write prices into. Existing files will be overwritten. Default: prices.journal" + "File to write prices into. Existing files will be overwritten. Default: prices.journal" &= explicit &= name "output-file" &= name "o" &= typ "FILE" - , argCryptoCurrencies = - [] + , argCryptoCurrencies = + [] &= help - "Cryptocurrencies to fetch prices for. Flag can be passed multiple times." + "Cryptocurrencies to fetch prices for. Flag can be passed multiple times." &= explicit &= name "c" &= name "crypto" &= typ "TICKER,..." - , argExcludedCurrencies = defaultExcludedCurrencies &= args &= typ - "EXCLUDED_CURRENCY ..." - , argDryRun = - False &= explicit &= name "dry-run" &= name "d" &= help + , argExcludedCurrencies = + defaultExcludedCurrencies + &= args + &= typ + "EXCLUDED_CURRENCY ..." + , argDryRun = + False + &= explicit + &= name "dry-run" + &= name "d" + &= help "Print the commodities and dates that would be processed." - } + } &= summary - ( "hledger-stockquotes v" - ++ showVersion version - ++ ", Pavan Rikhi 2020" - ) + ( "hledger-stockquotes v" + ++ showVersion version + ++ ", Pavan Rikhi 2020" + ) &= program "hledger-stockquotes" &= helpArg [name "h"] &= help "Generate HLedger Price Directives From Daily Stock Quotes." @@ -259,7 +290,9 @@ programDetails :: [String] -programDetails = lines [r| +programDetails = + lines + [r| hledger-stockquotes reads a HLedger journal file, queries the AlphaVantage stock quote API, and writes a new journal file containing price directives for each commodity. @@ -326,13 +359,38 @@ a configuration file in $XDG_CONFIG_HOME/hledger-stockquotes/config.yaml. It currently supports the following top-level keys: -- `api-key`: (string) Your AlphaVantage API Key -- `cryptocurrencies`: (list of string) Cryptocurrencies to Fetch -- `exclude`: (list of strings) Currencies to Exclude -- `rate-limit`: (bool) Obey AlphaVantage's Rate Limit +- `api-key`: (string) Your AlphaVantage API Key +- `cryptocurrencies`: (list of string) Cryptocurrencies to Fetch +- `exclude`: (list of strings) Currencies to Exclude +- `rate-limit`: (bool) Obey AlphaVantage's Rate Limit +- `commodity-aliases`: (map of strings) Rename journal commodities before + querying AlphaVantage Environmental variables will overide any config file options, and CLI flags will override both environmental variables & config file options. + + +ALIASES + +By specifying the `commedity-aliases` option in your configuration file, +you can rename the commodities used in your journal to the commodities +expected by AlphaVantage. + +Keys in the map should be your journal commities while their values are the +AlphaVantage ticker symbols: + + commodity-aliases: + MY_VTSAX: VTSAX + MY_BTC_CURRENCY: BTC + +Renaming is done after commodity exclusion, but before bucketing them into +equities & cryptocurrencies so the `exclude` list should use your symbols +while the `cryptocurrencies` list should use AlphaVantage's: + + journal -> exclude -> aliases -> cryptocurrencies + +Specifying aliases via command line options or environmental variables is +not currently supported. USAGE EXAMPLES diff --git a/hledger-stockquotes.cabal b/hledger-stockquotes.cabal --- a/hledger-stockquotes.cabal +++ b/hledger-stockquotes.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hledger-stockquotes -version: 0.1.2.1 +version: 0.1.3.0 synopsis: Generate HLedger Price Directives From Daily Stock Quotes. description: @hledger-stockquotes@ is an addon for that reads your journal file, pulls the historical stock prices for commodities, @@ -56,7 +56,7 @@ , safe >=0.3.5 && <1 , scientific <1 , split <1 - , text <2 + , text <3 , time <2 , unordered-containers <0.3 default-language: Haskell2010 @@ -73,11 +73,12 @@ , base >=4.7 && <5 , bytestring <1 , cmdargs >=0.6 && <1 + , containers <1 , directory <2 , hledger-stockquotes , raw-strings-qq <2 , safe-exceptions - , text <2 + , text <3 , time <2 , xdg-basedir <1 , yaml <1 diff --git a/src/Hledger/StockQuotes.hs b/src/Hledger/StockQuotes.hs --- a/src/Hledger/StockQuotes.hs +++ b/src/Hledger/StockQuotes.hs @@ -1,59 +1,67 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{- | Helper functions for the @hledger-stockquotes@ application. --} +-- | Helper functions for the @hledger-stockquotes@ application. module Hledger.StockQuotes ( getCommoditiesAndDateRange , fetchPrices , makePriceDirectives - , GenericPrice(..) - , getClosePrice + , unaliasAndBucketCommodities + , reAliasCommodities ) where -import Control.Concurrent ( threadDelay ) -import Control.Exception ( SomeException - , displayException - , try - ) -import Data.Bifunctor ( second ) -import Data.List.Split ( chunksOf ) -import Data.Maybe ( catMaybes ) -import Data.Scientific ( Scientific ) -import Data.Text.Encoding ( encodeUtf8 ) -import Data.Time ( Day - , UTCTime(utctDay) - , defaultTimeLocale - , formatTime - , fromGregorian - , getCurrentTime - , toGregorian - ) -import Hledger -import Safe.Foldable ( maximumMay - , minimumMay - ) -import System.IO ( hPutStrLn - , stderr - ) +import Control.Concurrent (threadDelay) +import Control.Exception + ( SomeException + , displayException + , try + ) +import Data.List.Split (chunksOf) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text.Encoding (encodeUtf8) +import Data.Time + ( Day + , UTCTime (utctDay) + , defaultTimeLocale + , formatTime + , fromGregorian + , getCurrentTime + , toGregorian + ) +import Hledger + ( CommoditySymbol + , Journal (..) + , Transaction (..) + , definputopts + , readJournalFile + , runExceptT + ) +import Safe.Foldable + ( maximumMay + , minimumMay + ) +import System.IO + ( hPutStrLn + , stderr + ) -import Web.AlphaVantage ( AlphaVantageResponse(..) - , Config - , CryptoPrices(..) - , Prices(..) - , getDailyCryptoPrices - , getDailyPrices - ) +import Web.AlphaVantage + ( AlphaVantageResponse (..) + , Config + , Prices (..) + , getDailyCryptoPrices + , getDailyPrices + ) -import qualified Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Lazy.Char8 as LC -import qualified Data.List as L -import qualified Data.Map.Strict as M -import qualified Data.Text as T +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.List as L +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import qualified Data.Text as T -- | Given a list of Commodities to exclude and a Journal File, return the @@ -62,21 +70,23 @@ getCommoditiesAndDateRange :: [T.Text] -> FilePath -> IO ([CommoditySymbol], Day, Day) getCommoditiesAndDateRange excluded journalPath = do - journal <- fmap (either error id) . runExceptT $ readJournalFile - definputopts - journalPath + journal <- + fmap (either error id) . runExceptT $ + readJournalFile + definputopts + journalPath currentTime <- getCurrentTime let commodities = - filter (`notElem` excluded) - $ M.keys (jcommodities journal) - <> M.keys (jinferredcommodities journal) - dates = map tdate $ jtxns journal + filter (`notElem` excluded) $ + M.keys (jcommodities journal) + <> M.keys (jinferredcommodities journal) + dates = map tdate $ jtxns journal currentYear = (\(y, _, _) -> y) $ toGregorian $ utctDay currentTime - minDate = case minimumMay dates of - Just d -> d + minDate = case minimumMay dates of + Just d -> d Nothing -> fromGregorian currentYear 1 1 maxDate = case maximumMay dates of - Just d -> d + Just d -> d Nothing -> utctDay currentTime return (L.sort $ L.nub commodities, minDate, maxDate) @@ -92,16 +102,18 @@ -- ^ Commodities to Fetch -> [T.Text] -- ^ Commodities to Classify as Cryptocurrencies + -> M.Map T.Text T.Text + -- ^ Map of aliases to transform journal commodities -> Day -- ^ Start of Price Range -> Day -- ^ End of Price Range -> Bool -- ^ Rate Limit Requests - -> IO [(CommoditySymbol, [(Day, GenericPrice)])] -fetchPrices cfg symbols cryptoCurrencies start end rateLimit = do + -> IO [(CommoditySymbol, [(Day, Prices)])] +fetchPrices cfg symbols cryptoCurrencies aliases start end rateLimit = do let (stockSymbols, cryptoSymbols) = - L.partition (`notElem` cryptoCurrencies) symbols + unaliasAndBucketCommodities symbols cryptoCurrencies aliases genericAction = map FetchStock stockSymbols <> map FetchCrypto cryptoSymbols if rateLimit @@ -109,74 +121,117 @@ else catMaybes <$> mapM fetch genericAction where fetch - :: AlphaRequest -> IO (Maybe (CommoditySymbol, [(Day, GenericPrice)])) + :: AlphaRequest -> IO (Maybe (CommoditySymbol, [(Day, Prices)])) fetch req = do (symbol, label, resp) <- case req of FetchStock symbol -> - (symbol, "Stock", ) + (symbol,"Stock",) + <$> try (getDailyPrices cfg symbol start end) + FetchCrypto symbol -> + (symbol,"Cryptocurrency",) <$> try - ( fmap (map (second Stock)) - <$> getDailyPrices cfg symbol start end - ) - FetchCrypto symbol -> (symbol, "Cryptocurrency", ) <$> try - ( fmap (map (second Crypto)) - <$> getDailyCryptoPrices cfg symbol "USD" start end - ) + ( getDailyCryptoPrices cfg symbol "USD" start end + ) case resp of Left (e :: SomeException) -> do - logError - $ "Error Fetching Prices for " - <> label - <> " `" - <> T.unpack symbol - <> "`:\n\t" - ++ displayException e - ++ "\n" + logError $ + "Error Fetching Prices for " + <> label + <> " `" + <> T.unpack symbol + <> "`:\n\t" + ++ displayException e + ++ "\n" return Nothing - Right (ApiError note) -> do - logError - $ "Error Fetching Prices for " - <> label - <> " `" - <> T.unpack symbol - <> "`:\n\t" - <> T.unpack note - <> "\n" + logError $ + "Error Fetching Prices for " + <> label + <> " `" + <> T.unpack symbol + <> "`:\n\t" + <> T.unpack note + <> "\n" return Nothing - Right (ApiResponse prices) -> return $ Just (symbol, prices) logError :: String -> IO () logError = hPutStrLn stderr +-- | Given a list of commodities from a journal, a list a cryptocurrencies, +-- and a map of aliases, return the a list of AlphaVantage equities +-- & cryptocurencies. +unaliasAndBucketCommodities + :: [CommoditySymbol] + -- ^ Journal symbols + -> [T.Text] + -- ^ Cryptocurrency symbols + -> M.Map T.Text T.Text + -- ^ Aliases + -> ([CommoditySymbol], [CommoditySymbol]) +unaliasAndBucketCommodities symbols cryptoCurrencies aliases = + L.partition (`notElem` cryptoCurrencies) $ + S.toList $ + S.fromList $ + map transformAliases symbols + where + transformAliases :: T.Text -> T.Text + transformAliases original = + fromMaybe original $ M.lookup original aliases + + +-- | Given a list of paired unaliased symbols, the original journal +-- commodities, and the map of aliases, generate a new list of paired +-- symbols that reflects the commodities in the original journal. +-- +-- Pairs with symbols in the journal but not in the aliases will be +-- unaltered. Pairs with aliases only in the journal will return only alias +-- items. Pairs for multiple aliases with return a set of items for each +-- alias. Pairs with symbols and aliases in the journal will return both +-- sets of items. +reAliasCommodities + :: [(CommoditySymbol, a)] + -- ^ Unaliased pairs of symbols + -> [CommoditySymbol] + -- ^ Original symbols from the journal + -> M.Map T.Text T.Text + -- ^ Aliases + -> [(CommoditySymbol, a)] +reAliasCommodities symbolPairs journalSymbols aliases = + concatMap reAlias symbolPairs + where + reAlias :: (CommoditySymbol, a) -> [(CommoditySymbol, a)] + reAlias s@(cs, a) = case M.lookup cs reverseAliases of + Nothing -> + [s] + Just revAliases -> + map (,a) $ filter (`elem` journalSymbols) $ NE.toList revAliases + reverseAliases :: M.Map T.Text (NE.NonEmpty T.Text) + reverseAliases = + let journalSymbolPairs = map (\s -> (s, NE.singleton s)) journalSymbols + in M.fromListWith (<>) + . (<> journalSymbolPairs) + . map (\(k, v) -> (v, NE.singleton k)) + $ M.assocs aliases + + -- | Types of AlphaVantage requests we make. Unified under one type so we -- write a generic fetching function that can be rate limited. data AlphaRequest = FetchStock CommoditySymbol | FetchCrypto CommoditySymbol --- | Union type for all the various prices we can return. -data GenericPrice - = Stock Prices - | Crypto CryptoPrices --- | Get the day's closing price. -getClosePrice :: GenericPrice -> Scientific -getClosePrice = \case - Stock Prices { pClose } -> pClose - Crypto CryptoPrices { cpClose } -> cpClose - -- | Perform the actions at a rate of 5 per minute, then return all the -- results. -- -- Note: Will log waiting times to stdout. rateLimitActions :: [IO a] -> IO [a] rateLimitActions a = case chunksOf 5 a of - [ first] -> sequence first - first : rest -> do - rest_ <- concat <$> mapM runAndDelay rest + [first] -> sequence first + first : rest -> do + rest_ <- concat <$> mapM runAndDelay rest first_ <- sequence first return $ first_ ++ rest_ [] -> return [] @@ -191,20 +246,21 @@ -- | Build the Price Directives for the Daily Prices of the given -- Commodities. makePriceDirectives - :: [(CommoditySymbol, [(Day, GenericPrice)])] -> LBS.ByteString + :: [(CommoditySymbol, [(Day, Prices)])] -> LBS.ByteString makePriceDirectives = (<> "\n") . LBS.intercalate "\n\n" . map makeDirectives where makeDirectives - :: (CommoditySymbol, [(Day, GenericPrice)]) -> LBS.ByteString + :: (CommoditySymbol, [(Day, Prices)]) -> LBS.ByteString makeDirectives (symbol, prices) = - LBS.intercalate "\n" - $ ("; " <> LBS.fromStrict (encodeUtf8 symbol)) - : map (makeDirective symbol) prices - makeDirective :: CommoditySymbol -> (Day, GenericPrice) -> LBS.ByteString - makeDirective symbol (day, prices) = LBS.intercalate - " " - [ "P" - , LC.pack $ formatTime defaultTimeLocale "%F" day - , LBS.fromStrict $ encodeUtf8 symbol - , "$" <> LC.pack (show $ getClosePrice prices) - ] + LBS.intercalate "\n" $ + ("; " <> LBS.fromStrict (encodeUtf8 symbol)) + : map (makeDirective symbol) prices + makeDirective :: CommoditySymbol -> (Day, Prices) -> LBS.ByteString + makeDirective symbol (day, prices) = + LBS.intercalate + " " + [ "P" + , LC.pack $ formatTime defaultTimeLocale "%F" day + , LBS.fromStrict $ encodeUtf8 symbol + , "$" <> LC.pack (show $ pClose prices) + ] diff --git a/src/Web/AlphaVantage.hs b/src/Web/AlphaVantage.hs --- a/src/Web/AlphaVantage.hs +++ b/src/Web/AlphaVantage.hs @@ -3,60 +3,66 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} + {- | A minimal client for the AlphaVantage API. Currently only supports the @TIME_SERIES_DAILY@ & @DIGITAL_CURRENCY_DAILY@ endpoints. - -} module Web.AlphaVantage - ( Config(..) - , AlphaVantageResponse(..) - , Prices(..) + ( Config (..) + , AlphaVantageResponse (..) + , Prices (..) , getDailyPrices - , CryptoPrices(..) , getDailyCryptoPrices - ) -where + ) where -import Data.Aeson ( (.:) - , (.:?) - , FromJSON(..) - , Value(Object) - , withObject - ) -import Data.Aeson.Types ( Parser ) -import Data.Scientific ( Scientific ) -import Data.Time ( Day - , defaultTimeLocale - , parseTimeM - ) -import GHC.Generics ( Generic ) -import Network.HTTP.Req ( (/~) - , (=:) - , GET(..) - , NoReqBody(..) - , defaultHttpConfig - , https - , jsonResponse - , req - , responseBody - , runReq - ) -import Text.Read ( readMaybe ) +import Control.Applicative + ( (<|>) + ) +import Data.Aeson + ( FromJSON (..) + , Value (Object) + , withObject + , (.:) + , (.:?) + ) +import Data.Aeson.Types (Parser) +import Data.Scientific (Scientific) +import Data.Time + ( Day + , defaultTimeLocale + , parseTimeM + ) +import GHC.Generics (Generic) +import Network.HTTP.Req + ( GET (..) + , NoReqBody (..) + , defaultHttpConfig + , https + , jsonResponse + , req + , responseBody + , runReq + , (/~) + , (=:) + ) +import Text.Read (readMaybe) -import qualified Data.HashMap.Strict as HM -import qualified Data.List as L -import qualified Data.Text as T +import qualified Data.HashMap.Strict as HM +import qualified Data.List as L +import qualified Data.Text as T -- | Configuration for the AlphaVantage API Client. -newtype Config = - Config - { cApiKey :: T.Text - -- ^ Your API Key. - } deriving (Show, Read, Eq, Generic) +newtype Config + = Config + { cApiKey :: T.Text + -- ^ Your API Key. + } + deriving (Show, Read, Eq, Generic) + -- | Wrapper type enumerating between successful responses and error -- responses with notes. data AlphaVantageResponse a @@ -64,107 +70,92 @@ | ApiError T.Text deriving (Show, Read, Eq, Generic, Functor) --- | Check for errors by attempting to parse a @Note@ field. If one does --- not exist, parse the inner type. -instance FromJSON a => FromJSON (AlphaVantageResponse a) where + +-- | Check for errors by attempting to parse a @Note@ or @Information@ +-- field. If one does not exist, parse the inner type. +instance (FromJSON a) => FromJSON (AlphaVantageResponse a) where parseJSON = withObject "AlphaVantageResponse" $ \v -> do mbErrorNote <- v .:? "Note" - case mbErrorNote of - Nothing -> ApiResponse <$> parseJSON (Object v) + mbErrorInfo <- v .:? "Information" + case mbErrorNote <|> mbErrorInfo of + Nothing -> ApiResponse <$> parseJSON (Object v) Just note -> return $ ApiError note + -- | List of Daily Prices for a Stock. -newtype PriceList = - PriceList - { fromPriceList :: [(Day, Prices)] - } deriving (Show, Read, Eq, Generic) +newtype PriceList + = PriceList + { fromPriceList :: [(Day, Prices)] + } + deriving (Show, Read, Eq, Generic) + instance FromJSON PriceList where parseJSON = withObject "PriceList" $ \v -> do inner <- v .: "Time Series (Daily)" let daysAndPrices = HM.toList inner PriceList - <$> mapM (\(d, ps) -> (,) <$> parseDay d <*> parseJSON ps) - daysAndPrices - where parseDay = parseTimeM True defaultTimeLocale "%F" + <$> mapM + (\(d, ps) -> (,) <$> parseDay d <*> parseJSON ps) + daysAndPrices + where + parseDay = parseTimeM True defaultTimeLocale "%F" + -- | The Single-Day Price Quotes & Volume for a Stock,. data Prices = Prices - { pOpen :: Scientific + { pOpen :: Scientific -- ^ Day's Opening Price - , pHigh :: Scientific + , pHigh :: Scientific -- ^ High Price of the Day - , pLow :: Scientific + , pLow :: Scientific -- ^ Low Price of the Day - , pClose :: Scientific + , pClose :: Scientific -- ^ Day's Closing Price - , pVolume :: Integer + , pVolume :: Scientific -- ^ Trading Volume for the Day } deriving (Show, Read, Eq, Generic) + instance FromJSON Prices where parseJSON = withObject "Prices" $ \v -> do - pOpen <- parseScientific $ v .: "1. open" - pHigh <- parseScientific $ v .: "2. high" - pLow <- parseScientific $ v .: "3. low" - pClose <- parseScientific $ v .: "4. close" + pOpen <- parseScientific $ v .: "1. open" + pHigh <- parseScientific $ v .: "2. high" + pLow <- parseScientific $ v .: "3. low" + pClose <- parseScientific $ v .: "4. close" pVolume <- parseScientific $ v .: "5. volume" - return Prices { .. } + return Prices {..} -- | List of Daily Prices for a Cryptocurrency. -newtype CryptoPriceList = - CryptoPriceList - { fromCryptoPriceList :: [(Day, CryptoPrices)] - } deriving (Show, Read, Eq, Generic) +newtype CryptoPriceList + = CryptoPriceList + { fromCryptoPriceList :: [(Day, Prices)] + } + deriving (Show, Read, Eq, Generic) + instance FromJSON CryptoPriceList where parseJSON = withObject "CryptoPriceList" $ \v -> do inner <- v .: "Time Series (Digital Currency Daily)" let daysAndPrices = HM.toList inner CryptoPriceList <$> mapM - (\(d, ps) -> (,) <$> parseAlphavantageDay d <*> parseJSON ps - ) - daysAndPrices - --- | The Single-Day Price Quotes, Volume, & Market Cap for --- a Cryptocurrency. -data CryptoPrices = CryptoPrices - { cpOpen :: Scientific - -- ^ Day's Opening Price - , cpHigh :: Scientific - -- ^ High Price of the Day - , cpLow :: Scientific - -- ^ Low Price of the Day - , cpClose :: Scientific - -- ^ Day's Closing Price - , cpVolume :: Scientific - -- ^ Trading Volume for the Day - , cpMarketCap :: Scientific - } - deriving (Show, Read, Eq, Generic) - -instance FromJSON CryptoPrices where - parseJSON = withObject "CryptoPrices" $ \v -> do - cpOpen <- parseScientific $ v .: "1b. open (USD)" - cpHigh <- parseScientific $ v .: "2b. high (USD)" - cpLow <- parseScientific $ v .: "3b. low (USD)" - cpClose <- parseScientific $ v .: "4b. close (USD)" - cpVolume <- parseScientific $ v .: "5. volume" - cpMarketCap <- parseScientific $ v .: "6. market cap (USD)" - return CryptoPrices { .. } + ( \(d, ps) -> (,) <$> parseAlphavantageDay d <*> parseJSON ps + ) + daysAndPrices parseAlphavantageDay :: String -> Parser Day parseAlphavantageDay = parseTimeM True defaultTimeLocale "%F" -parseScientific :: (MonadFail m, Read a) => m String -> m a + +parseScientific :: (MonadFail m) => m String -> m Scientific parseScientific parser = do val <- parser case readMaybe val of - Just x -> return x + Just x -> return x Nothing -> fail $ "Could not parse number: " ++ val @@ -177,19 +168,22 @@ -> Day -> IO (AlphaVantageResponse [(Day, Prices)]) getDailyPrices cfg symbol startDay endDay = do - resp <- runReq defaultHttpConfig $ req - GET - (https "www.alphavantage.co" /~ ("query" :: T.Text)) - NoReqBody - jsonResponse - ( ("function" =: ("TIME_SERIES_DAILY" :: T.Text)) - <> ("symbol" =: symbol) - <> ("outputsize" =: ("full" :: T.Text)) - <> ("datatype" =: ("json" :: T.Text)) - <> ("apikey" =: cApiKey cfg) - ) - return . fmap (filterByDate startDay endDay . fromPriceList) $ responseBody - resp + resp <- + runReq defaultHttpConfig $ + req + GET + (https "www.alphavantage.co" /~ ("query" :: T.Text)) + NoReqBody + jsonResponse + ( ("function" =: ("TIME_SERIES_DAILY" :: T.Text)) + <> ("symbol" =: symbol) + <> ("outputsize" =: ("full" :: T.Text)) + <> ("datatype" =: ("json" :: T.Text)) + <> ("apikey" =: cApiKey cfg) + ) + return . fmap (filterByDate startDay endDay . fromPriceList) $ + responseBody + resp -- | Fetch the Daily Prices for a Cryptocurrency, returning only the prices @@ -200,21 +194,24 @@ -> T.Text -> Day -> Day - -> IO (AlphaVantageResponse [(Day, CryptoPrices)]) + -> IO (AlphaVantageResponse [(Day, Prices)]) getDailyCryptoPrices cfg symbol market startDay endDay = do - resp <- runReq defaultHttpConfig $ req - GET - (https "www.alphavantage.co" /~ ("query" :: T.Text)) - NoReqBody - jsonResponse - ( ("function" =: ("DIGITAL_CURRENCY_DAILY" :: T.Text)) - <> ("symbol" =: symbol) - <> ("market" =: market) - <> ("apikey" =: cApiKey cfg) - ) + resp <- + runReq defaultHttpConfig $ + req + GET + (https "www.alphavantage.co" /~ ("query" :: T.Text)) + NoReqBody + jsonResponse + ( ("function" =: ("DIGITAL_CURRENCY_DAILY" :: T.Text)) + <> ("symbol" =: symbol) + <> ("market" =: market) + <> ("apikey" =: cApiKey cfg) + ) return . fmap (filterByDate startDay endDay . fromCryptoPriceList) $ responseBody resp + -- | Filter a list of prices to be within a range of two 'Day's. filterByDate :: Day -> Day -> [(Day, a)] -> [(Day, a)] diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -1,10 +1,10 @@ -import Hedgehog -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.Hedgehog +import Hedgehog +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range main :: IO () @@ -23,9 +23,10 @@ properties :: TestTree -properties = testGroup - "Properties" - [testProperty "Addition is Communative" testAdditionCommunative] +properties = + testGroup + "Properties" + [testProperty "Addition is Communative" testAdditionCommunative] where testAdditionCommunative :: Property testAdditionCommunative = property $ do