diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# CHANGELOG + +## v0.1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Pavan Rikhi (c) 2020 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Pavan Rikhi nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,65 @@ +# hledger-stockquotes + +[![hledger-stockquotes Build Status](https://travis-ci.org/prikhi/hledger-stockquotes.svg?branch=master)](https://travis-ci.org/prikhi/hledger-stockquotes) + +`hledger-stockquotes` is a CLI addon for [hledger](https://hledger.org) that +reads a journal file and pulls the historical prices for commodities from +[AlphaVantage](https://www.alphavantage.co/). To use this application, you'll +need a [free AlphaVantage API key](https://www.alphavantage.co/support/#api-key). + + +## Running + +This application is still in early development, so you'll need to clone this +repository first: + +``` +git clone https://github.com/prikhi/hledger-stockquotes.git +cd hledger-stockquotes +``` + +Then you can run the application: + +``` +stack run -- --help +``` + +Use the `-a` flag to pass in your API key and optionally pass the path to your +journal file: + +``` +stack run -- -a API_KEY -f accounting.journal +``` + +If you omit the `-f` flag, the journal file will fallback to the value of the +`LEDGER_FILE` environmental variable. If `LEDGER_FILE` is undefined, a fallback +of `~/.hledger.journal` will be used. + +You can omit the `-a` flag by setting the `ALPHAVANTAGE_KEY` environmental +variable. + +The output file defaults to `prices.journal`. You can customize this with the +`-o` flag. Note that the contents of the output file will be overwritten if the +file already exists. + +By default, the application will limit itself to 5 API requests a minute, as +specified by the AlphaVantage documentation. You can override this by using the +`-n` flag. You can have the application print the dates and commodities it will +fetch by passing the `--dry-run` flag. + + +## Manual Builds + +You can build the project with stack: `stack build` + +For development, you can enable fast builds with file-watching, +documentation-building, & test-running: `stack test --haddock --fast --file-watch` + +To build & open the documentation, run `stack haddock --open hledger-stockquotes` + +To install the executable to `~/.local/bin`, run `stack install`. + + +## LICENSE + +BSD-3 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE RecordWildCards #-} +module Main where + +import Control.Monad ( forM_ ) +import Data.Foldable ( asum ) +import Data.Maybe ( fromMaybe ) +import Data.Time ( Day + , formatTime + , defaultTimeLocale + ) +import Data.Version ( showVersion ) +import System.Console.CmdArgs ( (&=) + , Data + , Typeable + , typ + , help + , details + , enum + , ignore + , explicit + , name + , summary + , program + , helpArg + , cmdArgs + , args + ) +import System.Environment ( lookupEnv ) +import System.Exit ( exitFailure ) + +import Hledger.StockQuotes +import Web.AlphaVantage ( Config(..) ) +import Paths_hledger_stockquotes ( version ) + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T + + +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 -> + putStrLn + "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 + (commodities, start, end) <- getCommoditiesAndDateRange + (T.pack <$> excludedCurrencies) + journalFile + if not dryRun + then do + prices <- fetchPrices cfg commodities start end rateLimit + LBS.writeFile outputFile $ makePriceDirectives prices + else do + putStrLn + $ "Querying from " + <> showDate start + <> " to " + <> showDate end + putStrLn "Querying Commodities:" + forM_ commodities + $ \commodity -> putStrLn $ "\t" <> T.unpack commodity + where + showDate :: Day -> String + showDate = formatTime defaultTimeLocale "%Y-%m-%d" + + +data Args = + Args + { apiKey_ :: Maybe String + , rateLimit :: Bool + , journalFile_ :: Maybe FilePath + , outputFile :: FilePath + , excludedCurrencies :: [String] + , dryRun :: Bool + } deriving (Data, Typeable, Show, Eq) + +argSpec :: Args +argSpec = + Args + { apiKey_ = + 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_ = + Nothing + &= help + "Journal file to read commodities from. Default: $LEDGER_FILE or ~/.hledger.journal" + &= explicit + &= name "journal-file" + &= name "f" + &= typ "FILE" + , outputFile = + "prices.journal" + &= help "File to write prices into. Default: prices.journal" + &= explicit + &= 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." + } + &= summary + ( "hledger-stockquotes v" + ++ showVersion version + ++ ", Pavan Rikhi 2020" + ) + &= 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." + , "" + , "Warning: the output file will always be overwritten with the new " + , "price directives. We currently do not support appending to the " + , "output file." + , "" + , "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." + ] diff --git a/hledger-stockquotes.cabal b/hledger-stockquotes.cabal new file mode 100644 --- /dev/null +++ b/hledger-stockquotes.cabal @@ -0,0 +1,97 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: a7089d237d71e7e01442d12003aecf7d101611bfc38701eda170c61077f2fe80 + +name: hledger-stockquotes +version: 0.1.0.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, + and writes out a new journal file containing the respective price + directives. + . + The is used to fetch the + stock quotes and you will need a + to use this + program. + . + You can install @hledger-stockquotes@ with Stack: @stack install --resolver + nightly hledger-stockquotes@. Then run @hledger-stockquotes --help@ to see + the usage instructions & all available options. +category: Finance, Console +homepage: https://github.com/prikhi/hledger-stockquotes#readme +bug-reports: https://github.com/prikhi/hledger-stockquotes/issues +author: Pavan Rikhi +maintainer: pavan.rikhi@gmail.com +copyright: 2020 Pavan Rikhi +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/prikhi/hledger-stockquotes + +library + exposed-modules: + Hledger.StockQuotes + Web.AlphaVantage + other-modules: + Paths_hledger_stockquotes + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 + build-depends: + aeson >=1 && <2 + , base >=4.7 && <5 + , bytestring <1 + , containers <1 + , hledger-lib <2 + , req >=3 && <4 + , safe >=0.3.5 && <1 + , scientific <1 + , split <1 + , text <2 + , time <2 + , unordered-containers <0.3 + default-language: Haskell2010 + +executable hledger-stockquotes + main-is: Main.hs + other-modules: + Paths_hledger_stockquotes + hs-source-dirs: + 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 + , bytestring <1 + , cmdargs >=0.6 && <1 + , hledger-stockquotes + , text <2 + , time <2 + default-language: Haskell2010 + +test-suite hledger-stockquotes-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_hledger_stockquotes + hs-source-dirs: + tests + 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 + , hedgehog + , hledger-stockquotes + , tasty + , tasty-hedgehog + , tasty-hunit + default-language: Haskell2010 diff --git a/src/Hledger/StockQuotes.hs b/src/Hledger/StockQuotes.hs new file mode 100644 --- /dev/null +++ b/src/Hledger/StockQuotes.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- | Helper functions for the @hledger-stockquotes@ application. + +-} +module Hledger.StockQuotes where + +import Control.Exception ( SomeException + , try + ) +import Control.Concurrent ( threadDelay ) +import Data.List.Split ( chunksOf ) +import Data.Maybe ( catMaybes ) +import Data.Time ( Day + , UTCTime(utctDay) + , formatTime + , defaultTimeLocale + , getCurrentTime + , fromGregorian + , toGregorian + ) +import Data.Text.Encoding ( encodeUtf8 ) +import Hledger +import Safe.Foldable ( minimumMay + , maximumMay + ) + +import Web.AlphaVantage ( Config + , Prices(..) + , 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 + + +-- | Given a list of Commodities to exclude and a Journal File, return the +-- Commodities in the Journal and the minimum/maximum days from the +-- Journal. +getCommoditiesAndDateRange + :: [T.Text] -> FilePath -> IO ([CommoditySymbol], Day, Day) +getCommoditiesAndDateRange excluded journalPath = do + journal <- either error id <$> readJournalFile definputopts journalPath + currentTime <- getCurrentTime + let commodities = + 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 + Nothing -> fromGregorian currentYear 1 1 + maxDate = case maximumMay dates of + Just d -> d + Nothing -> utctDay currentTime + return (L.sort $ L.nub commodities, minDate, maxDate) + + +-- | 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. +fetchPrices + :: Config + -> [CommoditySymbol] + -> Day + -> Day + -> Bool + -> IO [(CommoditySymbol, [(Day, Prices)])] +fetchPrices cfg symbols start end rateLimit = do + let action symbol = try (getDailyPrices cfg symbol start end) >>= \case + Left (e :: SomeException) -> do + putStrLn + $ "Error Fetching Symbol `" + <> T.unpack symbol + <> "`: " + ++ show e + return Nothing + Right prices -> return $ Just (symbol, prices) + if rateLimit + then fmap catMaybes $ rateLimitActions $ map action symbols + else catMaybes <$> mapM action symbols + + +-- | Perform the actions at a rate of 5 per second, 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 + return $ first_ ++ rest_ + [] -> return [] + where + runAndDelay actions = do + results <- sequence actions + putStrLn "Waiting 60 seconds to respect API rate limits." + threadDelay (60 * 1_000_000) + return results + + +-- | Build the Price Directives for the Daily Prices of the given +-- Commodities. +makePriceDirectives :: [(CommoditySymbol, [(Day, Prices)])] -> LBS.ByteString +makePriceDirectives = LBS.intercalate "\n\n" . map makeDirectives + where + makeDirectives :: (CommoditySymbol, [(Day, Prices)]) -> LBS.ByteString + makeDirectives (symbol, prices) = + LBS.intercalate "\n" + $ ("; " <> LBS.fromStrict (encodeUtf8 symbol)) + : map (makeDirective symbol) prices + makeDirective :: CommoditySymbol -> (Day, Prices) -> LBS.ByteString + makeDirective symbol (day, prices) = LBS.intercalate + " " + [ "P" + , LC.pack $ formatTime defaultTimeLocale "%F" day + , LBS.fromStrict $ encodeUtf8 symbol + , "$" <> LC.pack (show $ pClose prices) + ] diff --git a/src/Web/AlphaVantage.hs b/src/Web/AlphaVantage.hs new file mode 100644 --- /dev/null +++ b/src/Web/AlphaVantage.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{- | A minimal client for the AlphaVantage API. + +Currently only supports the @Daily Time Series@ endpoint. + +-} +module Web.AlphaVantage + ( Config(..) + , Prices(..) + , getDailyPrices + ) +where + +import Data.Aeson ( (.:) + , FromJSON(..) + , withObject + ) +import Data.Scientific ( Scientific ) +import Data.Time ( Day + , parseTimeM + , defaultTimeLocale + ) +import GHC.Generics ( Generic ) +import Network.HTTP.Req ( (/~) + , (=:) + , GET(..) + , NoReqBody(..) + , runReq + , req + , defaultHttpConfig + , https + , jsonResponse + , responseBody + ) +import Text.Read ( readMaybe ) + +import qualified Data.Text as T +import qualified Data.HashMap.Strict as HM +import qualified Data.List as L + + +-- | Configuration for the AlphaVantage API Client. +newtype Config = + Config + { cApiKey :: T.Text + -- ^ Your API Key. + } deriving (Show, Read, Eq, Generic) + + +-- | List of Daily Prices for a Stock. +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" + +-- | The Single-Day Price Quotes & Volume for a Stock,. +data Prices = + Prices + { pOpen :: Scientific + , pHigh :: Scientific + , pLow :: Scientific + , pClose :: Scientific + , pVolume :: Integer + } 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" + 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 read: " ++ val + + +-- | Fetch the Daily Prices for a Stock, returning only the prices between +-- the two given dates. +getDailyPrices :: Config -> T.Text -> Day -> Day -> IO [(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 + . takeWhile ((<= endDay) . fst) + . dropWhile ((< startDay) . fst) + . L.sortOn fst + . fromPriceList + $ responseBody resp diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,34 @@ +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 + + +main :: IO () +main = defaultMain tests + + +tests :: TestTree +tests = testGroup "Tests" [unitTests, properties] + + +unitTests :: TestTree +unitTests = testGroup "Unit Tests" [testCase "2+2 = 4" testAddition] + where + testAddition :: Assertion + testAddition = (2 + 2) @?= (4 :: Integer) + + +properties :: TestTree +properties = testGroup + "Properties" + [testProperty "Addition is Communative" testAdditionCommunative] + where + testAdditionCommunative :: Property + testAdditionCommunative = property $ do + let genInt = Gen.int $ Range.linear 0 9001 + (a, b) <- forAll $ (,) <$> genInt <*> genInt + (a + b) === (b + a)