module B1.Data.Price.Google
  ( getGooglePrices
  , parseGoogleCsv
  ) where

import Control.Exception
import Data.Either
import Data.Maybe
import Data.Time
import Network.HTTP hiding (close)
import Network.Stream hiding (close)
import System.IO
import System.Locale

import B1.Data.Price
import B1.Data.String.Utils

-- | Get price information using Google Finance.
-- Returns a tuple of Nothing and a list of error messages if tthere was a
-- network problem or parsing issue.
getGooglePrices :: LocalTime -> LocalTime -> String
    -> IO (Either [Price] String)
getGooglePrices startDate endDate symbol = pricesOrError
  where
    formatDate = formatTime Data.Time.defaultTimeLocale "%m/%d/%y"
    formattedStartDate = formatDate startDate
    formattedEndDate = formatDate endDate

    url = "http://www.google.com/finance/historical?q=NASDAQ:" ++ symbol
        ++ "&startdate=" ++ formattedStartDate
        ++ "&enddate="   ++ formattedEndDate
        ++ "&output=csv"
  
    pricesOrError = do
      putStrLn url
      exceptionOrResult <- try $ simpleHTTP (getRequest url)
      return $ either handleGetException handleGetResult exceptionOrResult

handleGetException :: SomeException -> Either [Price] String
handleGetException exception = Right $ show exception

handleGetResult :: Either ConnError (Response String) -> Either [Price] String
handleGetResult = either handleConError handleResponse 

handleConError :: ConnError -> Either [Price] String
handleConError connError = Right $ show connError

handleResponse :: Response String -> Either [Price] String
handleResponse response =
  case rspCode response of
    (2, 0, 0) -> parseGoogleCsv (rspBody response) 
    (x, y, z) -> Right $ "Response error code: " ++ show x ++ show y ++ show z

-- | Parses the CSV response from Google Finance.
-- Exposed only for testing purposes.
parseGoogleCsv :: String -> Either [Price] String
parseGoogleCsv = maybe (Right "Invalid CSV format 1") pricesOrError
    . maybe Nothing (Just . parsePriceLines)
    . dropHeader
    . split '\n'

dropHeader :: [String] -> Maybe [String]
dropHeader (_:rest) = Just rest
dropHeader _ = Nothing

parsePriceLines :: [String] -> [Maybe Price]
parsePriceLines = map (parsePriceTokens . split ',')

parsePriceTokens :: [String] -> Maybe Price
parsePriceTokens (date:open:high:low:close:volume:_) = maybePrice
  where
    maybeStartTime = parseDateString date
    maybeEndTime = parseDateString date
    maybeOpen = parseValue open::Maybe Float
    maybeHigh = parseValue high::Maybe Float
    maybeLow = parseValue low::Maybe Float
    maybeClose = parseValue close::Maybe Float
    maybeVolume = parseValue volume::Maybe Int

    maybePrice =
      if all isJust [maybeStartTime, maybeEndTime]
          && all isJust [maybeOpen, maybeHigh, maybeLow, maybeClose]
          && all isJust [maybeVolume]
        then Just Price
          { startTime = fromJust maybeStartTime
          , endTime = fromJust maybeEndTime
          , open = fromJust maybeOpen
          , high = fromJust maybeHigh
          , low = fromJust maybeLow
          , close = fromJust maybeClose
          , volume = fromJust maybeVolume
          }
        else Nothing

parsePriceTokens _ = Nothing

parseDateString :: String -> Maybe LocalTime
parseDateString time =
  parseTimeM True Data.Time.defaultTimeLocale "%e-%b-%y-%C" (time ++ "-20")

parseValue :: (Read a) => String -> Maybe a
parseValue string =
  case reads string of
    [(value, "")] -> Just value
    _ -> Nothing

pricesOrError :: [Maybe Price] -> Either [Price] String
pricesOrError maybePrices = Left $ catMaybes maybePrices

