{-# LANGUAGE DeriveFunctor #-}
{-# 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(..)
    , AlphaVantageResponse(..)
    , Prices(..)
    , getDailyPrices
    ) where

import           Data.Aeson                     ( (.:)
                                                , (.:?)
                                                , FromJSON(..)
                                                , Value(Object)
                                                , withObject
                                                )
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


-- | Configuration for the AlphaVantage API Client.
newtype Config =
    Config
        { Config -> Text
cApiKey :: T.Text
        -- ^ Your API Key.
        } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq,  (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)

-- | Wrapper type enumerating between successful responses and error
-- responses with notes.
data AlphaVantageResponse a
    = ApiResponse a
    | ApiError T.Text
    deriving (Int -> AlphaVantageResponse a -> ShowS
[AlphaVantageResponse a] -> ShowS
AlphaVantageResponse a -> String
(Int -> AlphaVantageResponse a -> ShowS)
-> (AlphaVantageResponse a -> String)
-> ([AlphaVantageResponse a] -> ShowS)
-> Show (AlphaVantageResponse a)
forall a. Show a => Int -> AlphaVantageResponse a -> ShowS
forall a. Show a => [AlphaVantageResponse a] -> ShowS
forall a. Show a => AlphaVantageResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlphaVantageResponse a] -> ShowS
$cshowList :: forall a. Show a => [AlphaVantageResponse a] -> ShowS
show :: AlphaVantageResponse a -> String
$cshow :: forall a. Show a => AlphaVantageResponse a -> String
showsPrec :: Int -> AlphaVantageResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AlphaVantageResponse a -> ShowS
Show, ReadPrec [AlphaVantageResponse a]
ReadPrec (AlphaVantageResponse a)
Int -> ReadS (AlphaVantageResponse a)
ReadS [AlphaVantageResponse a]
(Int -> ReadS (AlphaVantageResponse a))
-> ReadS [AlphaVantageResponse a]
-> ReadPrec (AlphaVantageResponse a)
-> ReadPrec [AlphaVantageResponse a]
-> Read (AlphaVantageResponse a)
forall a. Read a => ReadPrec [AlphaVantageResponse a]
forall a. Read a => ReadPrec (AlphaVantageResponse a)
forall a. Read a => Int -> ReadS (AlphaVantageResponse a)
forall a. Read a => ReadS [AlphaVantageResponse a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AlphaVantageResponse a]
$creadListPrec :: forall a. Read a => ReadPrec [AlphaVantageResponse a]
readPrec :: ReadPrec (AlphaVantageResponse a)
$creadPrec :: forall a. Read a => ReadPrec (AlphaVantageResponse a)
readList :: ReadS [AlphaVantageResponse a]
$creadList :: forall a. Read a => ReadS [AlphaVantageResponse a]
readsPrec :: Int -> ReadS (AlphaVantageResponse a)
$creadsPrec :: forall a. Read a => Int -> ReadS (AlphaVantageResponse a)
Read, AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
(AlphaVantageResponse a -> AlphaVantageResponse a -> Bool)
-> (AlphaVantageResponse a -> AlphaVantageResponse a -> Bool)
-> Eq (AlphaVantageResponse a)
forall a.
Eq a =>
AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
$c/= :: forall a.
Eq a =>
AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
== :: AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
$c== :: forall a.
Eq a =>
AlphaVantageResponse a -> AlphaVantageResponse a -> Bool
Eq, (forall x.
 AlphaVantageResponse a -> Rep (AlphaVantageResponse a) x)
-> (forall x.
    Rep (AlphaVantageResponse a) x -> AlphaVantageResponse a)
-> Generic (AlphaVantageResponse a)
forall x. Rep (AlphaVantageResponse a) x -> AlphaVantageResponse a
forall x. AlphaVantageResponse a -> Rep (AlphaVantageResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (AlphaVantageResponse a) x -> AlphaVantageResponse a
forall a x.
AlphaVantageResponse a -> Rep (AlphaVantageResponse a) x
$cto :: forall a x.
Rep (AlphaVantageResponse a) x -> AlphaVantageResponse a
$cfrom :: forall a x.
AlphaVantageResponse a -> Rep (AlphaVantageResponse a) x
Generic, a -> AlphaVantageResponse b -> AlphaVantageResponse a
(a -> b) -> AlphaVantageResponse a -> AlphaVantageResponse b
(forall a b.
 (a -> b) -> AlphaVantageResponse a -> AlphaVantageResponse b)
-> (forall a b.
    a -> AlphaVantageResponse b -> AlphaVantageResponse a)
-> Functor AlphaVantageResponse
forall a b. a -> AlphaVantageResponse b -> AlphaVantageResponse a
forall a b.
(a -> b) -> AlphaVantageResponse a -> AlphaVantageResponse b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AlphaVantageResponse b -> AlphaVantageResponse a
$c<$ :: forall a b. a -> AlphaVantageResponse b -> AlphaVantageResponse a
fmap :: (a -> b) -> AlphaVantageResponse a -> AlphaVantageResponse b
$cfmap :: forall a b.
(a -> b) -> AlphaVantageResponse a -> AlphaVantageResponse b
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
    parseJSON :: Value -> Parser (AlphaVantageResponse a)
parseJSON = String
-> (Object -> Parser (AlphaVantageResponse a))
-> Value
-> Parser (AlphaVantageResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AlphaVantageResponse" ((Object -> Parser (AlphaVantageResponse a))
 -> Value -> Parser (AlphaVantageResponse a))
-> (Object -> Parser (AlphaVantageResponse a))
-> Value
-> Parser (AlphaVantageResponse a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        Maybe Text
mbErrorNote <- Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Note"
        case Maybe Text
mbErrorNote of
            Maybe Text
Nothing   -> a -> AlphaVantageResponse a
forall a. a -> AlphaVantageResponse a
ApiResponse (a -> AlphaVantageResponse a)
-> Parser a -> Parser (AlphaVantageResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)
            Just Text
note -> AlphaVantageResponse a -> Parser (AlphaVantageResponse a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaVantageResponse a -> Parser (AlphaVantageResponse a))
-> AlphaVantageResponse a -> Parser (AlphaVantageResponse a)
forall a b. (a -> b) -> a -> b
$ Text -> AlphaVantageResponse a
forall a. Text -> AlphaVantageResponse a
ApiError Text
note

-- | List of Daily Prices for a Stock.
newtype PriceList =
    PriceList
        { PriceList -> [(Day, Prices)]
fromPriceList :: [(Day, Prices)]
        } deriving (Int -> PriceList -> ShowS
[PriceList] -> ShowS
PriceList -> String
(Int -> PriceList -> ShowS)
-> (PriceList -> String)
-> ([PriceList] -> ShowS)
-> Show PriceList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PriceList] -> ShowS
$cshowList :: [PriceList] -> ShowS
show :: PriceList -> String
$cshow :: PriceList -> String
showsPrec :: Int -> PriceList -> ShowS
$cshowsPrec :: Int -> PriceList -> ShowS
Show, ReadPrec [PriceList]
ReadPrec PriceList
Int -> ReadS PriceList
ReadS [PriceList]
(Int -> ReadS PriceList)
-> ReadS [PriceList]
-> ReadPrec PriceList
-> ReadPrec [PriceList]
-> Read PriceList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PriceList]
$creadListPrec :: ReadPrec [PriceList]
readPrec :: ReadPrec PriceList
$creadPrec :: ReadPrec PriceList
readList :: ReadS [PriceList]
$creadList :: ReadS [PriceList]
readsPrec :: Int -> ReadS PriceList
$creadsPrec :: Int -> ReadS PriceList
Read, PriceList -> PriceList -> Bool
(PriceList -> PriceList -> Bool)
-> (PriceList -> PriceList -> Bool) -> Eq PriceList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PriceList -> PriceList -> Bool
$c/= :: PriceList -> PriceList -> Bool
== :: PriceList -> PriceList -> Bool
$c== :: PriceList -> PriceList -> Bool
Eq, (forall x. PriceList -> Rep PriceList x)
-> (forall x. Rep PriceList x -> PriceList) -> Generic PriceList
forall x. Rep PriceList x -> PriceList
forall x. PriceList -> Rep PriceList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PriceList x -> PriceList
$cfrom :: forall x. PriceList -> Rep PriceList x
Generic)

instance FromJSON PriceList where
    parseJSON :: Value -> Parser PriceList
parseJSON = String -> (Object -> Parser PriceList) -> Value -> Parser PriceList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PriceList" ((Object -> Parser PriceList) -> Value -> Parser PriceList)
-> (Object -> Parser PriceList) -> Value -> Parser PriceList
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        HashMap String Value
inner <- Object
v Object -> Text -> Parser (HashMap String Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Time Series (Daily)"
        let daysAndPrices :: [(String, Value)]
daysAndPrices = HashMap String Value -> [(String, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap String Value
inner
        [(Day, Prices)] -> PriceList
PriceList
            ([(Day, Prices)] -> PriceList)
-> Parser [(Day, Prices)] -> Parser PriceList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Value) -> Parser (Day, Prices))
-> [(String, Value)] -> Parser [(Day, Prices)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
d, Value
ps) -> (,) (Day -> Prices -> (Day, Prices))
-> Parser Day -> Parser (Prices -> (Day, Prices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Day
parseDay String
d Parser (Prices -> (Day, Prices))
-> Parser Prices -> Parser (Day, Prices)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Prices
forall a. FromJSON a => Value -> Parser a
parseJSON Value
ps)
                     [(String, Value)]
daysAndPrices
        where parseDay :: String -> Parser Day
parseDay = Bool -> TimeLocale -> String -> String -> Parser Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%F"

-- | The Single-Day Price Quotes & Volume for a Stock,.
data Prices = Prices
    { Prices -> Scientific
pOpen   :: Scientific
    , Prices -> Scientific
pHigh   :: Scientific
    , Prices -> Scientific
pLow    :: Scientific
    , Prices -> Scientific
pClose  :: Scientific
    , Prices -> Integer
pVolume :: Integer
    }
    deriving (Int -> Prices -> ShowS
[Prices] -> ShowS
Prices -> String
(Int -> Prices -> ShowS)
-> (Prices -> String) -> ([Prices] -> ShowS) -> Show Prices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prices] -> ShowS
$cshowList :: [Prices] -> ShowS
show :: Prices -> String
$cshow :: Prices -> String
showsPrec :: Int -> Prices -> ShowS
$cshowsPrec :: Int -> Prices -> ShowS
Show, ReadPrec [Prices]
ReadPrec Prices
Int -> ReadS Prices
ReadS [Prices]
(Int -> ReadS Prices)
-> ReadS [Prices]
-> ReadPrec Prices
-> ReadPrec [Prices]
-> Read Prices
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Prices]
$creadListPrec :: ReadPrec [Prices]
readPrec :: ReadPrec Prices
$creadPrec :: ReadPrec Prices
readList :: ReadS [Prices]
$creadList :: ReadS [Prices]
readsPrec :: Int -> ReadS Prices
$creadsPrec :: Int -> ReadS Prices
Read, Prices -> Prices -> Bool
(Prices -> Prices -> Bool)
-> (Prices -> Prices -> Bool) -> Eq Prices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prices -> Prices -> Bool
$c/= :: Prices -> Prices -> Bool
== :: Prices -> Prices -> Bool
$c== :: Prices -> Prices -> Bool
Eq, (forall x. Prices -> Rep Prices x)
-> (forall x. Rep Prices x -> Prices) -> Generic Prices
forall x. Rep Prices x -> Prices
forall x. Prices -> Rep Prices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prices x -> Prices
$cfrom :: forall x. Prices -> Rep Prices x
Generic)

instance FromJSON Prices where
    parseJSON :: Value -> Parser Prices
parseJSON = String -> (Object -> Parser Prices) -> Value -> Parser Prices
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Prices" ((Object -> Parser Prices) -> Value -> Parser Prices)
-> (Object -> Parser Prices) -> Value -> Parser Prices
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
        Scientific
pOpen   <- Parser String -> Parser Scientific
forall (m :: * -> *) b. (Read b, MonadFail m) => m String -> m b
parseScientific (Parser String -> Parser Scientific)
-> Parser String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"1. open"
        Scientific
pHigh   <- Parser String -> Parser Scientific
forall (m :: * -> *) b. (Read b, MonadFail m) => m String -> m b
parseScientific (Parser String -> Parser Scientific)
-> Parser String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"2. high"
        Scientific
pLow    <- Parser String -> Parser Scientific
forall (m :: * -> *) b. (Read b, MonadFail m) => m String -> m b
parseScientific (Parser String -> Parser Scientific)
-> Parser String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"3. low"
        Scientific
pClose  <- Parser String -> Parser Scientific
forall (m :: * -> *) b. (Read b, MonadFail m) => m String -> m b
parseScientific (Parser String -> Parser Scientific)
-> Parser String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"4. close"
        Integer
pVolume <- Parser String -> Parser Integer
forall (m :: * -> *) b. (Read b, MonadFail m) => m String -> m b
parseScientific (Parser String -> Parser Integer)
-> Parser String -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"5. volume"
        Prices -> Parser Prices
forall (m :: * -> *) a. Monad m => a -> m a
return Prices :: Scientific
-> Scientific -> Scientific -> Scientific -> Integer -> Prices
Prices { Integer
Scientific
pVolume :: Integer
pClose :: Scientific
pLow :: Scientific
pHigh :: Scientific
pOpen :: Scientific
pVolume :: Integer
pClose :: Scientific
pLow :: Scientific
pHigh :: Scientific
pOpen :: Scientific
.. }
      where
        parseScientific :: m String -> m b
parseScientific m String
parser = do
            String
val <- m String
parser
            case String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe String
val of
                Just b
x  -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
                Maybe b
Nothing -> String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ String
"Could not parse number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
val


-- | Fetch the Daily Prices for a Stock, returning only the prices between
-- the two given dates.
getDailyPrices
    :: Config
    -> T.Text
    -> Day
    -> Day
    -> IO (AlphaVantageResponse [(Day, Prices)])
getDailyPrices :: Config
-> Text -> Day -> Day -> IO (AlphaVantageResponse [(Day, Prices)])
getDailyPrices Config
cfg Text
symbol Day
startDay Day
endDay = do
    JsonResponse (AlphaVantageResponse PriceList)
resp <- HttpConfig
-> Req (JsonResponse (AlphaVantageResponse PriceList))
-> IO (JsonResponse (AlphaVantageResponse PriceList))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req (JsonResponse (AlphaVantageResponse PriceList))
 -> IO (JsonResponse (AlphaVantageResponse PriceList)))
-> Req (JsonResponse (AlphaVantageResponse PriceList))
-> IO (JsonResponse (AlphaVantageResponse PriceList))
forall a b. (a -> b) -> a -> b
$ GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse (AlphaVantageResponse PriceList))
-> Option 'Https
-> Req (JsonResponse (AlphaVantageResponse PriceList))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req
        GET
GET
        (Text -> Url 'Https
https Text
"www.alphavantage.co" Url 'Https -> Text -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ (Text
"query" :: T.Text))
        NoReqBody
NoReqBody
        Proxy (JsonResponse (AlphaVantageResponse PriceList))
forall a. Proxy (JsonResponse a)
jsonResponse
        (  Text
"function"
        Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"TIME_SERIES_DAILY" :: T.Text)
        Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"symbol"
        Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
symbol
        Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"outputsize"
        Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"full" :: T.Text)
        Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"datatype"
        Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"json" :: T.Text)
        Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"apikey"
        Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Config -> Text
cApiKey Config
cfg
        )
    AlphaVantageResponse [(Day, Prices)]
-> IO (AlphaVantageResponse [(Day, Prices)])
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaVantageResponse [(Day, Prices)]
 -> IO (AlphaVantageResponse [(Day, Prices)]))
-> (AlphaVantageResponse PriceList
    -> AlphaVantageResponse [(Day, Prices)])
-> AlphaVantageResponse PriceList
-> IO (AlphaVantageResponse [(Day, Prices)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PriceList -> [(Day, Prices)])
-> AlphaVantageResponse PriceList
-> AlphaVantageResponse [(Day, Prices)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PriceList -> [(Day, Prices)]
filterByDate (AlphaVantageResponse PriceList
 -> IO (AlphaVantageResponse [(Day, Prices)]))
-> AlphaVantageResponse PriceList
-> IO (AlphaVantageResponse [(Day, Prices)])
forall a b. (a -> b) -> a -> b
$ JsonResponse (AlphaVantageResponse PriceList)
-> HttpResponseBody (JsonResponse (AlphaVantageResponse PriceList))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (AlphaVantageResponse PriceList)
resp
  where
    filterByDate :: PriceList -> [(Day, Prices)]
    filterByDate :: PriceList -> [(Day, Prices)]
filterByDate =
        ((Day, Prices) -> Bool) -> [(Day, Prices)] -> [(Day, Prices)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<= Day
endDay) (Day -> Bool) -> ((Day, Prices) -> Day) -> (Day, Prices) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, Prices) -> Day
forall a b. (a, b) -> a
fst)
            ([(Day, Prices)] -> [(Day, Prices)])
-> (PriceList -> [(Day, Prices)]) -> PriceList -> [(Day, Prices)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Day, Prices) -> Bool) -> [(Day, Prices)] -> [(Day, Prices)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
startDay) (Day -> Bool) -> ((Day, Prices) -> Day) -> (Day, Prices) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day, Prices) -> Day
forall a b. (a, b) -> a
fst)
            ([(Day, Prices)] -> [(Day, Prices)])
-> (PriceList -> [(Day, Prices)]) -> PriceList -> [(Day, Prices)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Day, Prices) -> Day) -> [(Day, Prices)] -> [(Day, Prices)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Day, Prices) -> Day
forall a b. (a, b) -> a
fst
            ([(Day, Prices)] -> [(Day, Prices)])
-> (PriceList -> [(Day, Prices)]) -> PriceList -> [(Day, Prices)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PriceList -> [(Day, Prices)]
fromPriceList