{-# 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
        { 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
    = ApiResponse a
    | 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
    parseJSON = withObject "AlphaVantageResponse" $ \v -> do
        mbErrorNote <- v .:? "Note"
        case mbErrorNote 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)

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 parse number: " ++ 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 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 $ responseBody resp
  where
    filterByDate :: PriceList -> [(Day, Prices)]
    filterByDate =
        takeWhile ((<= endDay) . fst)
            . dropWhile ((< startDay) . fst)
            . L.sortOn fst
            . fromPriceList