{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Helper functions for the @hledger-stockquotes@ application.
module Hledger.StockQuotes
    ( getCommoditiesAndDateRange
    , fetchPrices
    , makePriceDirectives
    , unaliasAndBucketCommodities
    , reAliasCommodities
    ) where

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 Hledger.StockQuotes.Compat (allJournalCommodities)
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.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
-- Commodities in the Journal and the minimum/maximum days from the
-- Journal.
getCommoditiesAndDateRange
    :: [T.Text] -> FilePath -> IO ([CommoditySymbol], Day, Day)
getCommoditiesAndDateRange :: [Text] -> [Char] -> IO ([Text], Day, Day)
getCommoditiesAndDateRange [Text]
excluded [Char]
journalPath = do
    Journal
journal <-
        (Either [Char] Journal -> Journal)
-> IO (Either [Char] Journal) -> IO Journal
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Journal)
-> (Journal -> Journal) -> Either [Char] Journal -> Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Journal
forall a. HasCallStack => [Char] -> a
error Journal -> Journal
forall a. a -> a
id) (IO (Either [Char] Journal) -> IO Journal)
-> (ExceptT [Char] IO Journal -> IO (Either [Char] Journal))
-> ExceptT [Char] IO Journal
-> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT [Char] IO Journal -> IO (Either [Char] Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO Journal -> IO Journal)
-> ExceptT [Char] IO Journal -> IO Journal
forall a b. (a -> b) -> a -> b
$
            InputOpts -> [Char] -> ExceptT [Char] IO Journal
readJournalFile
                InputOpts
definputopts
                [Char]
journalPath
    UTCTime
currentTime <- IO UTCTime
getCurrentTime
    let commodities :: [Text]
commodities = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
excluded) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
allJournalCommodities Journal
journal
        dates :: [Day]
dates = (Transaction -> Day) -> [Transaction] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate ([Transaction] -> [Day]) -> [Transaction] -> [Day]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
journal
        currentYear :: Year
currentYear = (\(Year
y, MonthOfYear
_, MonthOfYear
_) -> Year
y) ((Year, MonthOfYear, MonthOfYear) -> Year)
-> (Year, MonthOfYear, MonthOfYear) -> Year
forall a b. (a -> b) -> a -> b
$ Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian (Day -> (Year, MonthOfYear, MonthOfYear))
-> Day -> (Year, MonthOfYear, MonthOfYear)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
currentTime
        minDate :: Day
minDate = case [Day] -> Maybe Day
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> Maybe a
minimumMay [Day]
dates of
            Just Day
d -> Day
d
            Maybe Day
Nothing -> Year -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Year
currentYear MonthOfYear
1 MonthOfYear
1
        maxDate :: Day
maxDate = case [Day] -> Maybe Day
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> Maybe a
maximumMay [Day]
dates of
            Just Day
d -> Day
d
            Maybe Day
Nothing -> UTCTime -> Day
utctDay UTCTime
currentTime
    ([Text], Day, Day) -> IO ([Text], Day, Day)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub [Text]
commodities, Day
minDate, Day
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 'stderr'.
fetchPrices
    :: Config
    -- ^ AlphaVantage Configuration
    -> [CommoditySymbol]
    -- ^ 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, Prices)])]
fetchPrices :: Config
-> [Text]
-> [Text]
-> Map Text Text
-> Day
-> Day
-> Bool
-> IO [(Text, [(Day, Prices)])]
fetchPrices Config
cfg [Text]
symbols [Text]
cryptoCurrencies Map Text Text
aliases Day
start Day
end Bool
rateLimit = do
    let ([Text]
stockSymbols, [Text]
cryptoSymbols) =
            [Text] -> [Text] -> Map Text Text -> ([Text], [Text])
unaliasAndBucketCommodities [Text]
symbols [Text]
cryptoCurrencies Map Text Text
aliases
        genericAction :: [AlphaRequest]
genericAction =
            (Text -> AlphaRequest) -> [Text] -> [AlphaRequest]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AlphaRequest
FetchStock [Text]
stockSymbols [AlphaRequest] -> [AlphaRequest] -> [AlphaRequest]
forall a. Semigroup a => a -> a -> a
<> (Text -> AlphaRequest) -> [Text] -> [AlphaRequest]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AlphaRequest
FetchCrypto [Text]
cryptoSymbols
    if Bool
rateLimit
        then ([Maybe (Text, [(Day, Prices)])] -> [(Text, [(Day, Prices)])])
-> IO [Maybe (Text, [(Day, Prices)])]
-> IO [(Text, [(Day, Prices)])]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Text, [(Day, Prices)])] -> [(Text, [(Day, Prices)])]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe (Text, [(Day, Prices)])]
 -> IO [(Text, [(Day, Prices)])])
-> IO [Maybe (Text, [(Day, Prices)])]
-> IO [(Text, [(Day, Prices)])]
forall a b. (a -> b) -> a -> b
$ [IO (Maybe (Text, [(Day, Prices)]))]
-> IO [Maybe (Text, [(Day, Prices)])]
forall a. [IO a] -> IO [a]
rateLimitActions ([IO (Maybe (Text, [(Day, Prices)]))]
 -> IO [Maybe (Text, [(Day, Prices)])])
-> [IO (Maybe (Text, [(Day, Prices)]))]
-> IO [Maybe (Text, [(Day, Prices)])]
forall a b. (a -> b) -> a -> b
$ (AlphaRequest -> IO (Maybe (Text, [(Day, Prices)])))
-> [AlphaRequest] -> [IO (Maybe (Text, [(Day, Prices)]))]
forall a b. (a -> b) -> [a] -> [b]
map AlphaRequest -> IO (Maybe (Text, [(Day, Prices)]))
fetch [AlphaRequest]
genericAction
        else [Maybe (Text, [(Day, Prices)])] -> [(Text, [(Day, Prices)])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, [(Day, Prices)])] -> [(Text, [(Day, Prices)])])
-> IO [Maybe (Text, [(Day, Prices)])]
-> IO [(Text, [(Day, Prices)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AlphaRequest -> IO (Maybe (Text, [(Day, Prices)])))
-> [AlphaRequest] -> IO [Maybe (Text, [(Day, Prices)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AlphaRequest -> IO (Maybe (Text, [(Day, Prices)]))
fetch [AlphaRequest]
genericAction
  where
    fetch
        :: AlphaRequest -> IO (Maybe (CommoditySymbol, [(Day, Prices)]))
    fetch :: AlphaRequest -> IO (Maybe (Text, [(Day, Prices)]))
fetch AlphaRequest
req = do
        (Text
symbol, [Char]
label, Either SomeException (AlphaVantageResponse [(Day, Prices)])
resp) <- case AlphaRequest
req of
            FetchStock Text
symbol ->
                (Text
symbol,[Char]
"Stock",)
                    (Either SomeException (AlphaVantageResponse [(Day, Prices)])
 -> (Text, [Char],
     Either SomeException (AlphaVantageResponse [(Day, Prices)])))
-> IO (Either SomeException (AlphaVantageResponse [(Day, Prices)]))
-> IO
     (Text, [Char],
      Either SomeException (AlphaVantageResponse [(Day, Prices)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (AlphaVantageResponse [(Day, Prices)])
-> IO (Either SomeException (AlphaVantageResponse [(Day, Prices)]))
forall e a. Exception e => IO a -> IO (Either e a)
try (Config
-> Text -> Day -> Day -> IO (AlphaVantageResponse [(Day, Prices)])
getDailyPrices Config
cfg Text
symbol Day
start Day
end)
            FetchCrypto Text
symbol ->
                (Text
symbol,[Char]
"Cryptocurrency",)
                    (Either SomeException (AlphaVantageResponse [(Day, Prices)])
 -> (Text, [Char],
     Either SomeException (AlphaVantageResponse [(Day, Prices)])))
-> IO (Either SomeException (AlphaVantageResponse [(Day, Prices)]))
-> IO
     (Text, [Char],
      Either SomeException (AlphaVantageResponse [(Day, Prices)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (AlphaVantageResponse [(Day, Prices)])
-> IO (Either SomeException (AlphaVantageResponse [(Day, Prices)]))
forall e a. Exception e => IO a -> IO (Either e a)
try
                        ( Config
-> Text
-> Text
-> Day
-> Day
-> IO (AlphaVantageResponse [(Day, Prices)])
getDailyCryptoPrices Config
cfg Text
symbol Text
"USD" Day
start Day
end
                        )
        case Either SomeException (AlphaVantageResponse [(Day, Prices)])
resp of
            Left (SomeException
e :: SomeException) -> do
                [Char] -> IO ()
logError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"Error Fetching Prices for "
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
label
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"  `"
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
symbol
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"`:\n\t"
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
e
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                Maybe (Text, [(Day, Prices)]) -> IO (Maybe (Text, [(Day, Prices)]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, [(Day, Prices)])
forall a. Maybe a
Nothing
            Right (ApiError Text
note) -> do
                [Char] -> IO ()
logError ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                    [Char]
"Error Fetching Prices for "
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
label
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" `"
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
symbol
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"`:\n\t"
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
note
                        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
                Maybe (Text, [(Day, Prices)]) -> IO (Maybe (Text, [(Day, Prices)]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, [(Day, Prices)])
forall a. Maybe a
Nothing
            Right (ApiResponse [(Day, Prices)]
prices) -> Maybe (Text, [(Day, Prices)]) -> IO (Maybe (Text, [(Day, Prices)]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, [(Day, Prices)])
 -> IO (Maybe (Text, [(Day, Prices)])))
-> Maybe (Text, [(Day, Prices)])
-> IO (Maybe (Text, [(Day, Prices)]))
forall a b. (a -> b) -> a -> b
$ (Text, [(Day, Prices)]) -> Maybe (Text, [(Day, Prices)])
forall a. a -> Maybe a
Just (Text
symbol, [(Day, Prices)]
prices)

    logError :: String -> IO ()
    logError :: [Char] -> IO ()
logError = Handle -> [Char] -> IO ()
hPutStrLn Handle
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 :: [Text] -> [Text] -> Map Text Text -> ([Text], [Text])
unaliasAndBucketCommodities [Text]
symbols [Text]
cryptoCurrencies Map Text Text
aliases =
    (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
cryptoCurrencies) ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$
        Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$
            [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$
                (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
transformAliases [Text]
symbols
  where
    transformAliases :: T.Text -> T.Text
    transformAliases :: Text -> Text
transformAliases Text
original =
        Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
original (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
original Map Text Text
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 :: forall a. [(Text, a)] -> [Text] -> Map Text Text -> [(Text, a)]
reAliasCommodities [(Text, a)]
symbolPairs [Text]
journalSymbols Map Text Text
aliases =
    ((Text, a) -> [(Text, a)]) -> [(Text, a)] -> [(Text, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, a) -> [(Text, a)]
forall a. (Text, a) -> [(Text, a)]
reAlias [(Text, a)]
symbolPairs
  where
    reAlias :: (CommoditySymbol, a) -> [(CommoditySymbol, a)]
    reAlias :: forall a. (Text, a) -> [(Text, a)]
reAlias s :: (Text, a)
s@(Text
cs, a
a) = case Text -> Map Text (NonEmpty Text) -> Maybe (NonEmpty Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
cs Map Text (NonEmpty Text)
reverseAliases of
        Maybe (NonEmpty Text)
Nothing ->
            [(Text, a)
s]
        Just NonEmpty Text
revAliases ->
            (Text -> (Text, a)) -> [Text] -> [(Text, a)]
forall a b. (a -> b) -> [a] -> [b]
map (,a
a) ([Text] -> [(Text, a)]) -> [Text] -> [(Text, a)]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
journalSymbols) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
revAliases
    reverseAliases :: M.Map T.Text (NE.NonEmpty T.Text)
    reverseAliases :: Map Text (NonEmpty Text)
reverseAliases =
        let journalSymbolPairs :: [(Text, NonEmpty Text)]
journalSymbolPairs = (Text -> (Text, NonEmpty Text))
-> [Text] -> [(Text, NonEmpty Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
s -> (Text
s, Text -> NonEmpty Text
forall a. a -> NonEmpty a
NE.singleton Text
s)) [Text]
journalSymbols
         in (NonEmpty Text -> NonEmpty Text -> NonEmpty Text)
-> [(Text, NonEmpty Text)] -> Map Text (NonEmpty Text)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith NonEmpty Text -> NonEmpty Text -> NonEmpty Text
forall a. Semigroup a => a -> a -> a
(<>)
                ([(Text, NonEmpty Text)] -> Map Text (NonEmpty Text))
-> ([(Text, Text)] -> [(Text, NonEmpty Text)])
-> [(Text, Text)]
-> Map Text (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, NonEmpty Text)]
-> [(Text, NonEmpty Text)] -> [(Text, NonEmpty Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, NonEmpty Text)]
journalSymbolPairs)
                ([(Text, NonEmpty Text)] -> [(Text, NonEmpty Text)])
-> ([(Text, Text)] -> [(Text, NonEmpty Text)])
-> [(Text, Text)]
-> [(Text, NonEmpty Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, NonEmpty Text))
-> [(Text, Text)] -> [(Text, NonEmpty Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> (Text
v, Text -> NonEmpty Text
forall a. a -> NonEmpty a
NE.singleton Text
k))
                ([(Text, Text)] -> Map Text (NonEmpty Text))
-> [(Text, Text)] -> Map Text (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Text Text
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


-- | 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 :: forall a. [IO a] -> IO [a]
rateLimitActions [IO a]
a = case MonthOfYear -> [IO a] -> [[IO a]]
forall e. MonthOfYear -> [e] -> [[e]]
chunksOf MonthOfYear
5 [IO a]
a of
    [[IO a]
first] -> [IO a] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [IO a]
first
    [IO a]
first : [[IO a]]
rest -> do
        [a]
rest_ <- [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> IO [[a]] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([IO a] -> IO [a]) -> [[IO a]] -> IO [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [IO a] -> IO [a]
forall {t :: * -> *} {a}. Traversable t => t (IO a) -> IO (t a)
runAndDelay [[IO a]]
rest
        [a]
first_ <- [IO a] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [IO a]
first
        [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [a]
first_ [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rest_
    [] -> [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    runAndDelay :: t (IO a) -> IO (t a)
runAndDelay t (IO a)
actions = do
        t a
results <- t (IO a) -> IO (t a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)
sequence t (IO a)
actions
        [Char] -> IO ()
putStrLn [Char]
"Waiting 60 seconds to respect API rate limits."
        MonthOfYear -> IO ()
threadDelay (MonthOfYear
60 MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
* MonthOfYear
1_000_000)
        t a -> IO (t a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return t a
results


-- | Build the Price Directives for the Daily Prices of the given
-- Commodities.
makePriceDirectives
    :: [(CommoditySymbol, [(Day, Prices)])] -> LBS.ByteString
makePriceDirectives :: [(Text, [(Day, Prices)])] -> ByteString
makePriceDirectives = (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") (ByteString -> ByteString)
-> ([(Text, [(Day, Prices)])] -> ByteString)
-> [(Text, [(Day, Prices)])]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
LBS.intercalate ByteString
"\n\n" ([ByteString] -> ByteString)
-> ([(Text, [(Day, Prices)])] -> [ByteString])
-> [(Text, [(Day, Prices)])]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [(Day, Prices)]) -> ByteString)
-> [(Text, [(Day, Prices)])] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [(Day, Prices)]) -> ByteString
makeDirectives
  where
    makeDirectives
        :: (CommoditySymbol, [(Day, Prices)]) -> LBS.ByteString
    makeDirectives :: (Text, [(Day, Prices)]) -> ByteString
makeDirectives (Text
symbol, [(Day, Prices)]
prices) =
        ByteString -> [ByteString] -> ByteString
LBS.intercalate ByteString
"\n" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
            (ByteString
"; " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> ByteString
LBS.fromStrict (Text -> StrictByteString
encodeUtf8 Text
symbol))
                ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ((Day, Prices) -> ByteString) -> [(Day, Prices)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> (Day, Prices) -> ByteString
makeDirective Text
symbol) [(Day, Prices)]
prices
    makeDirective :: CommoditySymbol -> (Day, Prices) -> LBS.ByteString
    makeDirective :: Text -> (Day, Prices) -> ByteString
makeDirective Text
symbol (Day
day, Prices
prices) =
        ByteString -> [ByteString] -> ByteString
LBS.intercalate
            ByteString
" "
            [ ByteString
"P"
            , [Char] -> ByteString
LC.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> Day -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%F" Day
day
            , StrictByteString -> ByteString
LBS.fromStrict (StrictByteString -> ByteString) -> StrictByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> StrictByteString
encodeUtf8 Text
symbol
            , ByteString
"$" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
LC.pack (Scientific -> [Char]
forall a. Show a => a -> [Char]
show (Scientific -> [Char]) -> Scientific -> [Char]
forall a b. (a -> b) -> a -> b
$ Prices -> Scientific
pClose Prices
prices)
            ]