{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Yahoo.HistoricalData (
    requestData,
    ) where

import Control.Lens
import Control.Monad (join, (>>=))
import Data.Aeson
import Data.Aeson.Lens (key, _Array)
import qualified Data.Aeson.Types as AT
import qualified Data.ByteString.Lazy as BS
import qualified Data.HashMap.Strict as HM
import Data.Text (unpack, toLower, replace)
import Data.Time
import qualified Data.Vector as V
import Network.Wreq (responseBody, Response)
import Text.Printf

import Data (DayQuote(..))
import Yahoo.Query

type Symbol = String

instance FromJSON Day where
    parseJSON (AT.String t) = return $ read $ unpack t
    parseJSON invalid       = AT.typeMismatch "Day" invalid

instance FromJSON DayQuote where
    parseJSON =  withObject "DayQuote" $ \v -> do
        symbol      <- v .: "Symbol"
        date        <- fmap read $ v .: "Date"
        open        <- fmap read $ v .: "Open"
        high        <- fmap read $ v .: "High"
        low         <- fmap read $ v .: "Low"
        close       <- fmap read $ v .: "Close"
        volume      <- fmap read $ v .: "Volume"
        adjclose    <- fmap read $ v .: "Adj_Close"
        return DayQuote{..}

jsonClean :: Value -> Value
jsonClean (Object o) = Object . HM.fromList . map lowerPair . HM.toList $ o
  where
    lowerPair (key, val) = (replace "_" "" $ toLower key, val)
jsonClean x = x

requestData :: Symbol -> Day -> Day -> IO (Result [DayQuote])
requestData sym fromDate toDate = do
    body <- requestDataBody sym fromDate toDate
    let maybeVs = requestGetValues body
    return $ sequence $ maybe undefined (map fromJSON . V.toList) maybeVs

requestDataBody :: Symbol -> Day -> Day -> IO (Response BS.ByteString)
requestDataBody sym fromDate toDate = request $ printf "SELECT * FROM yahoo.finance.historicaldata WHERE symbol = \"%s\" AND startDate = \"%s\" AND endDate = \"%s\"" sym (show fromDate) (show toDate)

requestGetValues :: Response BS.ByteString -> Maybe (V.Vector Value)
requestGetValues body = body ^? responseBody . key "query" . key "results" . key "quote" . _Array
