diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,14 @@ ## master +## v0.1.2.0 + +* Add support for fetching cryptocurrency prices with the `-c` flag and + `cryptocurrencies` config option. +* Add support for config file at `$XDG_CONFIG_HOME/hstockquotes/config.yaml` + with `api-key`, `exclude`, & `rate-limit` options. + + ## v0.1.1.0 * Don't write out a journal file if no prices were successfully fetched. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -22,7 +22,7 @@ At the bare minimum, you need to set an `ALPHAVANTAGE_KEY` environmental variable or use the `-a` switch to specify your AlphaVantage key: -``` +```sh hledger-stockquotes -a MY_API_KEY -f accounting.journal ``` @@ -33,7 +33,7 @@ The output file can be set with the `-o` flag: -``` +```sh hledger-stockquotes -a MY_API_KEY -o prices/2021.journal ``` @@ -49,7 +49,7 @@ when fetching them. You can exclude commodities by passing them as arguments to `hledger-stockquotes`: -``` +```sh hledger-stockquotes -a MY_API_KEY AUTO TA_VFFVX ``` @@ -57,6 +57,19 @@ directive(`D`). +### Cryptocurrencies + +You can specify a list of cryptocurrencies that you wish to pull prices for +with the `-c` or `--crypto` flag. You can pass a comma-separated list of +currencies or pass the flag multiple times. We will split the commodities from +your journal file into a list of equities & cryptocurrencies and hit the +appropriate AlphaVantage route for each. + +```sh +hledger-stockquotes -a MY_API_KEY -c BTC,ETH --crypto XMR -c BNB +``` + + ### API Limits AlphaVantage has an API request limit of 5 requests per minute. @@ -69,11 +82,34 @@ ranges that would be queried instead of making requests to AlphaVantage. +### Configuration File + +`hledger-stockquotes` can also be configured via a YAML file at +`$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: + +```yaml +rate-limit: false +api-key: DeAdBeEf9001 +crypto-currencies: + - BTC + - XMR +exclude: + - USD + - AUTO +``` + +CLI flags & environmental variables will override config file settings. + + ### Additional Documentation The `--help` flag provides more thorough documentation on all available flags: -``` +```sh hledger-stockquotes --help ``` @@ -83,7 +119,7 @@ This project has not yet been packaged for any OSes or Linux distributions, so you'll have to clone this repository & compile/install the code yourself: -``` +```sh git clone https://github.com/prikhi/hledger-stockquotes.git cd hledger-stockquotes stack install @@ -93,14 +129,14 @@ directory. Ensure that the directory is included in your `PATH` environmental variable. Then you can run the application: -``` +```sh hledger-stockquotes --help ``` Since the executable has the `hledger-` prefix, you can also use it with the `hledger` command: -``` +```sh hledger stockquotes -- --help ``` diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,15 +1,30 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} module Main where +import Control.Applicative ( (<|>) ) +import Control.Exception.Safe ( try ) import Control.Monad ( forM_ ) -import Data.Foldable ( asum ) +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 @@ -26,15 +41,18 @@ , 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 ( Config(..) ) +import Web.AlphaVantage import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T @@ -42,28 +60,23 @@ main :: IO () main = do - Args {..} <- cmdArgs argSpec - journalFileEnv <- lookupEnv "LEDGER_FILE" - apiKeyEnv <- lookupEnv "ALPHAVANTAGE_KEY" - apiKey <- case asum [apiKey_, apiKeyEnv] of - Just k -> return k - Nothing -> - logError - "Error: Pass an AlphaVantage API Key with `-a` or $ALPHAVANTAGE_KEY." - >> exitFailure - - let journalFile = - fromMaybe "~/.hledger.journal" $ asum [journalFile_, journalFileEnv] - cfg = Config $ T.pack apiKey + cfgArgs <- cmdArgs argSpec + cfgFile <- loadConfigFile + AppConfig {..} <- mergeArgsEnvCfg cfgFile cfgArgs + let cfg = Config $ T.pack apiKey (commodities, start, end) <- getCommoditiesAndDateRange (T.pack <$> excludedCurrencies) journalFile if not dryRun then do - prices <- fetchPrices cfg commodities start end rateLimit + prices <- fetchPrices cfg + commodities + cryptoCurrencies + start + end + rateLimit if null prices - then logError - "Error: No price directives were able to be fetched." + then logError "No price directives were able to be fetched." else LBS.writeFile outputFile $ makePriceDirectives prices else do putStrLn @@ -71,47 +84,140 @@ <> showDate start <> " to " <> showDate end - putStrLn "Querying Commodities:" - forM_ commodities - $ \commodity -> putStrLn $ "\t" <> T.unpack commodity + let (stocks, cryptos) = + partition (`notElem` cryptoCurrencies) commodities + putStrLn "Querying Stocks:" + forM_ stocks $ \commodity -> putStrLn $ "\t" <> T.unpack commodity + putStrLn "Querying CryptoCurrencies:" + forM_ cryptos $ \commodity -> putStrLn $ "\t" <> T.unpack commodity where showDate :: Day -> String showDate = formatTime defaultTimeLocale "%Y-%m-%d" - logError :: String -> IO () - logError = hPutStrLn stderr -data Args = Args - { apiKey_ :: Maybe String +logError :: String -> IO () +logError = hPutStrLn stderr . ("[ERROR] " <>) + + + +-- CONFIGURATION + +data AppConfig = AppConfig + { apiKey :: String , rateLimit :: Bool - , journalFile_ :: Maybe FilePath + , journalFile :: FilePath , outputFile :: FilePath , excludedCurrencies :: [String] + , cryptoCurrencies :: [T.Text] , dryRun :: Bool } + deriving (Show, Eq) + +defaultExcludedCurrencies :: [String] +defaultExcludedCurrencies = ["$", "USD"] + +-- | Merge the Arguments, Environmental Variables, & Configuration File +-- into an 'AppConfig. +-- +-- Arguments override environmental variables, which overrides the +-- configuration file. +mergeArgsEnvCfg :: ConfigFile -> Args -> IO AppConfig +mergeArgsEnvCfg ConfigFile {..} Args {..} = do + envJournalFile <- lookupEnv "LEDGER_FILE" + 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." + >> exitFailure + let journalFile = + fromMaybe "~/.hledger.journal" $ argJournalFile <|> envJournalFile + rateLimit = + fromMaybe True $ either (const cfgRateLimit) Just argRateLimit + excludedCurrencies = + 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 + outputFile = argOutputFile + dryRun = argDryRun + return AppConfig { .. } + + +data ConfigFile = ConfigFile + { cfgApiKey :: Maybe String + , cfgRateLimit :: Maybe Bool + , cfgExcludedCurrencies :: Maybe [String] + , cfgCryptoCurrencies :: Maybe [String] + } + deriving (Show, Eq) + +instance FromJSON ConfigFile where + parseJSON = withObject "ConfigFile" $ \o -> do + cfgApiKey <- o .:? "api-key" + cfgRateLimit <- o .:? "rate-limit" + cfgExcludedCurrencies <- o .:? "exclude" + cfgCryptoCurrencies <- o .:? "cryptocurrencies" + return ConfigFile { .. } + +loadConfigFile :: IO ConfigFile +loadConfigFile = do + configFile <- getUserConfigFile "hledger-stockquotes" "config.yaml" + 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 + else return defaultConfig + where + defaultConfig :: ConfigFile + defaultConfig = ConfigFile Nothing Nothing Nothing Nothing + + + +data Args = Args + { argApiKey :: Maybe String + , argRateLimit :: Either () Bool + , argJournalFile :: Maybe FilePath + , argOutputFile :: FilePath + , argExcludedCurrencies :: [String] + , argCryptoCurrencies :: [String] + , argDryRun :: Bool + } deriving (Data, Typeable, Show, Eq) argSpec :: Args argSpec = Args - { apiKey_ = + { argApiKey = Nothing &= help "Your AlphaVantage API key. Default: $ALPHAVANTAGE_KEY" &= explicit &= name "api-key" &= name "a" &= typ "ALPHAVANTAGE_KEY" - , rateLimit = enum - [ True - &= help "Apply rate-limting for the API" - &= ignore - , False - &= help "Disable rate-limiting for the API" - &= explicit - &= name "no-rate-limit" - &= name "n" - ] - , journalFile_ = + , argRateLimit = enum + [ Left () + &= 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" + , Right False + &= help "Disable rate-limiting for the API" + &= explicit + &= name "no-rate-limit" + &= name "n" + ] + , argJournalFile = Nothing &= help "Journal file to read commodities from. Default: $LEDGER_FILE or ~/.hledger.journal" @@ -119,7 +225,7 @@ &= name "journal-file" &= name "f" &= typ "FILE" - , outputFile = + , argOutputFile = "prices.journal" &= help "File to write prices into. Existing files will be overwritten. Default: prices.journal" @@ -127,10 +233,19 @@ &= name "output-file" &= name "o" &= typ "FILE" - , excludedCurrencies = ["$", "USD"] &= args &= typ - "EXCLUDED_CURRENCY ..." - , dryRun = False &= explicit &= name "dry-run" &= name "d" &= help - "Print the commodities and dates that would be processed." + , argCryptoCurrencies = + [] + &= help + "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 + "Print the commodities and dates that would be processed." } &= summary ( "hledger-stockquotes v" @@ -140,66 +255,97 @@ &= program "hledger-stockquotes" &= helpArg [name "h"] &= help "Generate HLedger Price Directives From Daily Stock Quotes." - &= details - [ "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." - , "" - , "" - , "DESCRIPTION" - , "" - , "By default, we find all non-USD commodities in your " - , "journal file and query AlphaVantage for their stock prices " - , "over the date range used in the journal file. Currently, we " - , "only support public U.S. equities & do not call out to AlphVantage's" - , "FOREX or Crypto API routes. If you have commodities that are " - , "not supported by AlphaVantage, hledger-stockquotes will output " - , "an error when attempting to processing them. To avoid processing " - , "of unsupported currencies, you can pass in any commodities to " - , "exclude as arguments. If you use the default commodity directive " - , "in your journal file, hledger will include an `AUTO` commodity " - , "when parsing your journal." - , "" - , "" - , "API LIMITS" - , "" - , "AlphVantage's API limits users to 5 requests per minute. We respect " - , "this limit by waiting for 60 seconds after every 5 commities we process. " - , "You can ignore the rate-limiting by using the `-n` flag, but " - , "requests are more likely to fail. You can use the `-d` flag to print " - , "out the dates & currencies that we will fetch to avoid any unecessary " - , "processing or API requests." - , "" - , "" - , "OUTPUT FILE" - , "" - , "You can use the `-o` flag to set the file we will write the " - , "generated price directives into. By default, we write to " - , "`prices.journal`." - , "" - , "Warning: the output file will always be overwritten with the new " - , "price directives. We currently do not support appending to the " - , "output file." - , "" - , "" - , "ENVIRONMENTAL VARIABLES" - , "" - , "If no `-f` flag is passed and the LEDGER_FILE environmental " - , "variable is set, the program will use that as the default " - , "HLedger file. Otherwise ~/.hledger.journal will be used." - , "" - , "Instead of passing the `-a` flag with your AlphaVantage API key, " - , "you can set the ALPHAVANTAGE_KEY environmental variable instead." - , "" - , "" - , "USAGE EXAMPLES" - , "" - , "Fetch prices for all commodities in the default journal file:" - , " hledger-stockquotes -a " - , "" - , "Output prices into a custom journal file:" - , " hledger-stockquotes -a -o prices/2021.journal" - , "" - , "Ignore the default, foreign, & crypto commodities:" - , " hledger-stockquotes -a AUTO BTC ETH EUR" - ] + &= details programDetails + + +programDetails :: [String] +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. + + +DESCRIPTION + +By default, we find all non-USD commodities in your journal file and query +AlphaVantage for their stock prices over the date range used in the journal +file. Currently, we only support public U.S. equities & cryptocurrencies +& do not call out to AlphaVantage's FOREX API routes. + +If you have commodities that are not supported by AlphaVantage, +hledger-stockquotes will output an error when attempting to processing +them. To avoid processing of unsupported currencies, you can pass in any +commodities to exclude as arguments. If you use the default commodity +directive in your journal file, hledger will include an `AUTO` commodity +when parsing your journal. + + +CRYPTOCURRENCIES + +We support feching daily closing prices for all cryptocurrencies supported +by AlphaVantage. Use the `-c` flag to specify which commodities are +cryptocurrencies. You can pass the flag multiple times or specify them as +a comma-separated list. For the listed cryptocurrencies, we will hit +AlphaVantage's Daily Crypto Prices API route instead of the normal Stock +Prices route. + + +API LIMITS + +AlphaVantage's API limits users to 5 requests per minute. We respect this +limit by waiting for 60 seconds after every 5 commities we process. You +can ignore the rate-limiting by using the `-n` flag, but requests are more +likely to fail. You can use the `-d` flag to print out the dates +& currencies that we will fetch to avoid any unecessary processing or API +requests. + + +OUTPUT FILE + +You can use the `-o` flag to set the file we will write the generated price +directives into. By default, we write to `prices.journal`. + +Warning: the output file will always be overwritten with the new price +directives. We currently do not support appending to the output file. + + +ENVIRONMENTAL VARIABLES + +If no `-f` flag is passed and the LEDGER_FILE environmental variable is +set, the program will use that as the default HLedger file. Otherwise +~/.hledger.journal will be used. + +Instead of passing the `-a` flag with your AlphaVantage API key, you can +set the ALPHAVANTAGE_KEY environmental variable instead. + + +CONFIGURATION FILE + +If you have common options you constantly pass to the application, you can +specify them in a YAML configuration file. We attempt to parse +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 + +Environmental variables will overide any config file options, and CLI flags +will override both environmental variables & config file options. + + +USAGE EXAMPLES + +Fetch prices for all commodities in the default journal file: + hledger-stockquotes -a + +Output prices into a custom journal file: + hledger-stockquotes -a -o prices/2021.journal + +Fetch prices for all commodities, including Bitcoin: + hledger-stockquotes -a -c BTC + +Ignore the default, foreign, & crypto commodities: + hledger-stockquotes -a AUTO BTC ETH EUR +|] diff --git a/hledger-stockquotes.cabal b/hledger-stockquotes.cabal --- a/hledger-stockquotes.cabal +++ b/hledger-stockquotes.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.3. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: 3aa877fb077a2f97f6c9f6cd6234051d71632bb973ebd221b1dac93398f75728 +-- hash: aa47c22c727d8989eac0b986130271d3066dd141a5237566d7c9a0e13db0a0b6 name: hledger-stockquotes -version: 0.1.1.0 +version: 0.1.2.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, @@ -49,12 +49,12 @@ src ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 build-depends: - aeson >=1 && <2 + aeson ==1.* , base >=4.7 && <5 , bytestring <1 , containers <1 , hledger-lib <2 - , req >=3 && <4 + , req ==3.* , safe >=0.3.5 && <1 , scientific <1 , split <1 @@ -71,12 +71,18 @@ app ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T" build-depends: - base >=4.7 && <5 + aeson ==1.* + , base >=4.7 && <5 , bytestring <1 , cmdargs >=0.6 && <1 + , directory <2 , hledger-stockquotes + , raw-strings-qq <2 + , safe-exceptions , text <2 , time <2 + , xdg-basedir <1 + , yaml <1 default-language: Haskell2010 test-suite hledger-stockquotes-test diff --git a/src/Hledger/StockQuotes.hs b/src/Hledger/StockQuotes.hs --- a/src/Hledger/StockQuotes.hs +++ b/src/Hledger/StockQuotes.hs @@ -1,19 +1,30 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {- | Helper functions for the @hledger-stockquotes@ application. -} -module Hledger.StockQuotes where +module Hledger.StockQuotes + ( getCommoditiesAndDateRange + , fetchPrices + , makePriceDirectives + , GenericPrice(..) + , getClosePrice + ) +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) @@ -33,7 +44,9 @@ import Web.AlphaVantage ( AlphaVantageResponse(..) , Config + , CryptoPrices(..) , Prices(..) + , getDailyCryptoPrices , getDailyPrices ) @@ -70,44 +83,89 @@ -- | Fetch the Prices for the Commodities from the AlphaVantage API, -- limiting the returned prices between the given Days. -- --- Note: Fetching errors are currently logged to stdout. +-- Note: Fetching errors are currently logged to 'stderr'. fetchPrices :: Config + -- ^ AlphaVantage Configuration -> [CommoditySymbol] + -- ^ Commodities to Fetch + -> [T.Text] + -- ^ Commodities to Classify as Cryptocurrencies -> Day + -- ^ Start of Price Range -> Day + -- ^ End of Price Range -> Bool - -> IO [(CommoditySymbol, [(Day, Prices)])] -fetchPrices cfg symbols start end rateLimit = do + -- ^ Rate Limit Requests + -> IO [(CommoditySymbol, [(Day, GenericPrice)])] +fetchPrices cfg symbols cryptoCurrencies start end rateLimit = do + let (stockSymbols, cryptoSymbols) = + L.partition (`notElem` cryptoCurrencies) symbols + genericAction = + map FetchStock stockSymbols <> map FetchCrypto cryptoSymbols if rateLimit - then fmap catMaybes $ rateLimitActions $ map action symbols - else catMaybes <$> mapM action symbols + then fmap catMaybes $ rateLimitActions $ map fetch genericAction + else catMaybes <$> mapM fetch genericAction where - action :: CommoditySymbol -> IO (Maybe (CommoditySymbol, [(Day, Prices)])) - action symbol = try (getDailyPrices cfg symbol start end) >>= \case - Left (e :: SomeException) -> do - logError - $ "Error Fetching Prices for Symbol `" - <> T.unpack symbol - <> "`:\n\t" - ++ displayException e - ++ "\n" - return Nothing + fetch :: AlphaRequest -> IO (Maybe (CommoditySymbol, [(Day, GenericPrice)])) + fetch req = do + (symbol, label, resp) <- case req of + FetchStock symbol -> + (symbol, "Stock", ) + <$> 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 + ) + case resp of + Left (e :: SomeException) -> do + 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 Symbol `" - <> T.unpack symbol - <> "`:\n\t" - <> T.unpack note - <> "\n" - return Nothing + Right (ApiError note) -> do + logError + $ "Error Fetching Prices for " + <> label + <> " `" + <> T.unpack symbol + <> "`:\n\t" + <> T.unpack note + <> "\n" + return Nothing - Right (ApiResponse prices) -> return $ Just (symbol, prices) + Right (ApiResponse prices) -> return $ Just (symbol, prices) + logError :: String -> IO () logError = hPutStrLn stderr +-- | 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 second, then return all the -- results. -- @@ -130,19 +188,20 @@ -- | Build the Price Directives for the Daily Prices of the given -- Commodities. -makePriceDirectives :: [(CommoditySymbol, [(Day, Prices)])] -> LBS.ByteString +makePriceDirectives + :: [(CommoditySymbol, [(Day, GenericPrice)])] -> LBS.ByteString makePriceDirectives = (<> "\n") . LBS.intercalate "\n\n" . map makeDirectives where - makeDirectives :: (CommoditySymbol, [(Day, Prices)]) -> LBS.ByteString + makeDirectives :: (CommoditySymbol, [(Day, GenericPrice)]) -> LBS.ByteString makeDirectives (symbol, prices) = LBS.intercalate "\n" $ ("; " <> LBS.fromStrict (encodeUtf8 symbol)) : map (makeDirective symbol) prices - makeDirective :: CommoditySymbol -> (Day, Prices) -> LBS.ByteString + 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 $ pClose prices) + , "$" <> LC.pack (show $ getClosePrice prices) ] diff --git a/src/Web/AlphaVantage.hs b/src/Web/AlphaVantage.hs --- a/src/Web/AlphaVantage.hs +++ b/src/Web/AlphaVantage.hs @@ -5,7 +5,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {- | A minimal client for the AlphaVantage API. -Currently only supports the @Daily Time Series@ endpoint. +Currently only supports the @TIME_SERIES_DAILY@ & @DIGITAL_CURRENCY_DAILY@ +endpoints. -} module Web.AlphaVantage @@ -13,7 +14,10 @@ , AlphaVantageResponse(..) , Prices(..) , getDailyPrices - ) where + , CryptoPrices(..) + , getDailyCryptoPrices + ) +where import Data.Aeson ( (.:) , (.:?) @@ -21,6 +25,7 @@ , Value(Object) , withObject ) +import Data.Aeson.Types ( Parser ) import Data.Scientific ( Scientific ) import Data.Time ( Day , defaultTimeLocale @@ -59,7 +64,7 @@ | ApiError T.Text deriving (Show, Read, Eq, Generic, Functor) --- | Check for errors by attempting to parse a `Note` field. If one does +-- | 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 parseJSON = withObject "AlphaVantageResponse" $ \v -> do @@ -86,10 +91,15 @@ -- | The Single-Day Price Quotes & Volume for a Stock,. data Prices = Prices { pOpen :: Scientific + -- ^ Day's Opening Price , pHigh :: Scientific + -- ^ High Price of the Day , pLow :: Scientific + -- ^ Low Price of the Day , pClose :: Scientific + -- ^ Day's Closing Price , pVolume :: Integer + -- ^ Trading Volume for the Day } deriving (Show, Read, Eq, Generic) @@ -101,14 +111,63 @@ pClose <- parseScientific $ v .: "4. close" pVolume <- parseScientific $ v .: "5. volume" return Prices { .. } - where - parseScientific parser = do - val <- parser - case readMaybe val of - Just x -> return x - Nothing -> fail $ "Could not parse number: " ++ val +-- | List of Daily Prices for a Cryptocurrency. +newtype CryptoPriceList = + CryptoPriceList + { fromCryptoPriceList :: [(Day, CryptoPrices)] + } 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 { .. } + + +parseAlphavantageDay :: String -> Parser Day +parseAlphavantageDay = parseTimeM True defaultTimeLocale "%F" + +parseScientific :: (MonadFail m, Read a) => m String -> m a +parseScientific parser = do + val <- parser + case readMaybe val of + Just x -> return x + Nothing -> fail $ "Could not parse number: " ++ val + + -- | Fetch the Daily Prices for a Stock, returning only the prices between -- the two given dates. getDailyPrices @@ -123,22 +182,43 @@ (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 + ( ("function" =: ("TIME_SERIES_DAILY" :: T.Text)) + <> ("symbol" =: symbol) + <> ("outputsize" =: ("full" :: T.Text)) + <> ("datatype" =: ("json" :: T.Text)) + <> ("apikey" =: cApiKey cfg) ) - return . fmap filterByDate $ responseBody resp - where - filterByDate :: PriceList -> [(Day, Prices)] - filterByDate = - takeWhile ((<= endDay) . fst) - . dropWhile ((< startDay) . fst) - . L.sortOn fst - . fromPriceList + return . fmap (filterByDate startDay endDay . fromPriceList) $ responseBody + resp + + +-- | Fetch the Daily Prices for a Cryptocurrency, returning only the prices +-- between the two given dates. +getDailyCryptoPrices + :: Config + -> T.Text + -> T.Text + -> Day + -> Day + -> IO (AlphaVantageResponse [(Day, CryptoPrices)]) +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) + ) + 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)] +filterByDate startDay endDay = + takeWhile ((<= endDay) . fst) + . dropWhile ((< startDay) . fst) + . L.sortOn fst