hledger-stockquotes 0.1.2.1 → 0.1.3.0

raw patch · 8 files changed

+558/−388 lines, 8 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• README.md +36/−6
• Setup.hs +2/−0
• app/Main.hs +196/−138
• hledger-stockquotes.cabal +5/−4
• src/Hledger/StockQuotes.hs +165/−109
• src/Web/AlphaVantage.hs +119/−122
• tests/Spec.hs +10/−9

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

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

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

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

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

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

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

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