hledger-stockquotes 0.1.1.0 → 0.1.2.0

raw patch · 6 files changed

+510/−175 lines, 6 filesdep +directorydep +raw-strings-qqdep +safe-exceptionsdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, raw-strings-qq, safe-exceptions, xdg-basedir, yaml

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +43/−7
• app/Main.hs +252/−106
• hledger-stockquotes.cabal +12/−6
• src/Hledger/StockQuotes.hs +88/−29
• src/Web/AlphaVantage.hs +107/−27

@@ -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.

@@ -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 ``` 

@@ -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 <your-api-key>"-               , ""-               , "Output prices into a custom journal file:"-               , "    hledger-stockquotes -a <your-api-key> -o prices/2021.journal"-               , ""-               , "Ignore the default, foreign, & crypto commodities:"-               , "    hledger-stockquotes -a <your-api-key> 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 <your-api-key>++Output prices into a custom journal file:+    hledger-stockquotes -a <your-api-key> -o prices/2021.journal++Fetch prices for all commodities, including Bitcoin:+    hledger-stockquotes -a <your-api-key> -c BTC++Ignore the default, foreign, & crypto commodities:+    hledger-stockquotes -a <your-api-key> AUTO BTC ETH EUR+|]

@@ -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 <https://hledger.org/ hledger> 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

@@ -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)         ]

@@ -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