diff --git a/Finance-Quote-Yahoo.cabal b/Finance-Quote-Yahoo.cabal --- a/Finance-Quote-Yahoo.cabal +++ b/Finance-Quote-Yahoo.cabal @@ -1,5 +1,5 @@ Name: Finance-Quote-Yahoo -Version: 0.1 +Version: 0.2 Description: Obtain quote data from finance.yahoo.com Synopsis: Obtain quote data from finance.yahoo.com Category: Web @@ -9,6 +9,6 @@ License-file: LICENSE Author: brad clawsie Maintainer: haskell@fastmail.fm -Build-Depends: base, network, HTTP, HTTP-Simple, MissingH +Build-Depends: base, network, HTTP, HTTP-Simple, MissingH, time>=1.1.1 Exposed-modules: Finance.Quote.Yahoo ghc-options: -O diff --git a/Finance/Quote/Yahoo.hs b/Finance/Quote/Yahoo.hs --- a/Finance/Quote/Yahoo.hs +++ b/Finance/Quote/Yahoo.hs @@ -4,40 +4,79 @@ finance.yahoo.com, which delivers a csv file with data for various fields, which are documented at http:\/\/www.gummy-stuff.org\/Yahoo-data.htm. -The only exported function is getQuote, which takes a list of quote symbols -(in the finance sense of \"symbol\" - YHOO,GOOG etc), a list of fields, and -returns a list of pairs for each symbol. Upon any problem, Nothing is -returned. +The homepage for this module is +http:\/\/www.b7j0c.org\/content\/haskell-yquote.html +The license for this module is at +http:\/\/www.b7j0c.org\/content\/license.txt + +Since this uses Data.Time.Format, ghc-6.6.1 or greater is required. + +Error reporting is somewhat of a mixed model in this module. Where strict +errors of data construction occur, these will be noted as fatal error() +signals, so the error can be noted and fixed. An example of this would be +putting the start and end data in the wrong order for the retrieval of +historical quotes or the creation of a malformed URI. On the other hand, +I continue to propogate Nothing() for networking issues as there may be +external issues creating these errors for which one may want program +execution to continue. My personal tendency is to fail early when +possible and practical. + + +Exported functions: + +getQuote, which takes a list of quote symbols (in the finance sense of +\"symbol\" - YHOO,GOOG etc), a list of fields, and +returns a Data.Map, where the keys are pairs (symbol,field) and +values are the returned Strings. Upon any problem, Nothing is +returned. I have not cast the data into stronger types than String since +Yahoo is inconsistent about what is returned in the csv. Fields often +contain punctuation, symbols, as well as numbers. So really, they are +Strings. + +getHistoricalQuote, which takes a quote symbol, and two Data.Time.Calendar +Day types, one for the starting date to receive quote data, and one for the +end date. Yahoo does not let you choose the fields to see in historical +quotes, data is limited to price and volume information. + Here is small complete program illustrating the use of this module @ module Main where import Finance\.Quote\.Yahoo - quoteSymbolList = \[\"YHOO\",\"^DJI\"\] :: [QuoteSymbol] - quoteFieldsList = \[\"s\",\"l1\",\"c\"\] :: [QuoteField] + import Data\.Time\.Calendar + import Data\.Map + quoteSymbolList = [\"YHOO\",\"^DJI\"] :: [QuoteSymbol] + quoteFieldsList = [\"s\",\"l1\",\"c\"] :: [QuoteField] main = do - q <- getQuote quoteSymbolList quoteFieldsList - case q of - Nothing -> error \"no return\" - Just l -> print l - return () -@ - -which outputs: - -@ - \[\[(\"s\",\"YHOO\"),(\"l1\",\"26.69\"),(\"c\",\"-0.28 - -1.04%\")\], - \[(\"s\",\"^DJI\"),(\"l1\",\"13577.87\"),(\"c\",\"+76.17 - +0.56%\")\]\] + q <- getQuote quoteSymbolList quoteFieldsList + case q of + Nothing -> error \"no map\" + Just m -> case (Data.Map.lookup (\"YHOO\",\"l1\") m) of + Nothing -> print \"no match\" + Just a -> print a + let startDate = Data.Time.Calendar.fromGregorian 2007 07 01 + let endDate = Data.Time.Calendar.fromGregorian 2007 07 03 + h <- getHistoricalQuote (head quoteSymbolList) startDate endDate + case h of + Nothing -> error \"no historical\" + Just l -> sequence $ Prelude.map print l + return () @ -} -module Finance.Quote.Yahoo (getQuote,defaultFields, - QuoteField,QuoteSymbol,QuoteValue) where +module Finance.Quote.Yahoo (getQuote,getHistoricalQuote,defaultQuoteFields, + baseQuoteURI,baseHistoricalURI, + QuoteField,QuoteSymbol,QuoteValue,Quote, + QuoteCurrency,HistoricalQuote) where import qualified Network.HTTP.Simple as H (httpGet) -import qualified Data.String as S (join,replace,split) +import qualified Data.String as S (join,split) import qualified Network.URI as U (parseURI,escapeURIString, isUnescapedInURI) +import qualified Data.Time.Calendar as T (Day(..),fromGregorian) +import qualified Data.Time.Format as F (formatTime) +import qualified System.Locale as L (defaultTimeLocale) +import qualified Data.Map as M (fromList,Map(..)) {- License info: @@ -47,52 +86,177 @@ -} --- | This is the base uri to get csv quotes. -baseURI = "http://finance.yahoo.com/d/quotes.csv" :: String - type QuoteField = String type QuoteSymbol = String type QuoteValue = String +type QuoteCSV = String +type Quote = [(QuoteField,QuoteValue)] --- | If you just want the symbol, closing price and change, use this. -defaultFields = ["s","l1","c"] :: [QuoteField] +-- | fetchCSV is a convenience function broken out to isolate HTTP use. +fetchCSV :: QuoteSymbol -> IO (Maybe String) +fetchCSV s = case U.parseURI s of + Nothing -> error("uri malformed:" ++ s) + Just uri -> H.httpGet uri +-- | This is the base uri to get csv quotes. Exported. +baseQuoteURI = "http://finance.yahoo.com/d/quotes.csv" :: String + +-- | If you just want the name, latest price and change, use this. Exported. +defaultQuoteFields = ["n","l1","c"] :: [QuoteField] + -- | quoteReq will build a String representation of a Yahoo Finance CSV -- request URI. quoteReq :: [QuoteSymbol] -> [QuoteField] -> String quoteReq symbols fields = U.escapeURIString U.isUnescapedInURI - (baseURI ++ "?s=" ++ - (S.join "+" symbols) ++ "&f=" ++ (concat fields)) + $ baseQuoteURI ++ "?s=" ++ + (S.join "+" symbols) ++ "&f=" ++ (concat fields) --- | getQuote takes two args - the symbols, and list of the fields you want. --- The return value is a list of lookup lists, one list per symbol requested, --- that match the fields you specified with their values. --- For example, if you were to provide +-- | parseQuote will take a list of symbols, a list of fields, and the +-- csv data and return a Data.Map, as described below (see getQuote). +-- If there is a mismatch in the number of fields being zipped to +-- produce the map, an error is triggered. +parseQuote :: [QuoteSymbol] -> [QuoteField] -> QuoteCSV -> + Maybe (M.Map (QuoteSymbol, QuoteField) QuoteValue) +parseQuote symbols fields csv = + let l = concat $ map (S.split ",") $ lines $ + filter (\c -> notElem c "\r\"") csv + p = [(x,y) | x <- symbols, y <- fields] in + case (length p == length l) of + True -> Just (M.fromList $ zip p l) + False -> error("mismatch in fields and returned data") + +-- | getQuote will take a list of symbols, a list of fields, and will +-- return a Data.Map, where the key type is +-- (symbol,field) +-- and the value type is whatever quote value string is returned. +-- An example map entry: -- --- \[\"^DJI\",\"YHOO\"\] as the symbols +-- key: \(\"YHOO\",\"c\"\), value: \"24.00\" -- --- \[\"s\",\"c\"\] as the fields, +-- Which gives you the closing price (c) for the symbol YHOO. -- --- the response structure would be +-- NOTE! +-- This function does NOT alter the casing of the quote symbols passed +-- in the first parameter. These symbols are used as the first element +-- of the Map key tuple without altering them. Be careful! This function +-- is exported. +getQuote :: [QuoteSymbol] -> [QuoteField] -> + IO (Maybe (M.Map (QuoteSymbol, QuoteField) QuoteValue)) +getQuote symbols fields = + do + trycsv <- fetchCSV (quoteReq symbols fields) + case trycsv of + Nothing -> return Nothing + Just csv -> return $ parseQuote symbols fields csv + +-- | This is the base uri to get csv historical quote data. Exported. +baseHistoricalURI = "http://ichart.finance.yahoo.com/table.csv" + +-- | Float is not an fully appropriate currency type, beware. Exported. +type QuoteCurrency = Float + +-- | HistoricalQuote reflects the row form of a yahoo historical quote: +-- Date,Open,High,Low,Close,Volume,Adj Close (taken from the csv itself). +-- Exported. +data HistoricalQuote = + HistoricalQuote { + symbol :: QuoteSymbol, + date :: T.Day, + open :: QuoteCurrency, + high :: QuoteCurrency, + low :: QuoteCurrency, + close :: QuoteCurrency, + adjclose :: QuoteCurrency, + volume :: Int + } deriving Show + +-- | historicalQuoteReq will build a String representation of a +-- Yahoo Finance CSV historical quote request URI. +historicalQuoteReq :: QuoteSymbol -> T.Day -> T.Day -> String +historicalQuoteReq symbol start end = + let (startDay,startMonth,startYear) = dateArgs start + (endDay,endMonth,endYear) = dateArgs end in + U.escapeURIString U.isUnescapedInURI + $ baseHistoricalURI ++ "?s=" ++ symbol ++ + "&a=" ++ startMonth ++ "&b=" ++ startDay ++ "&c=" ++ startYear ++ + "&d=" ++ endMonth ++ "&e=" ++ endDay ++ "&f=" ++ endYear + where + -- Return the string args for the URI. + -- Note when parsing months - for some odd reason Yahoo has decided + -- that month numbers should be zero-based...06 = July, etc. + dateArgs :: T.Day -> (String,String,String) + dateArgs t = (day,month,year) where + dtl = L.defaultTimeLocale + day = F.formatTime dtl "%d" t + month = show $ (read (F.formatTime dtl "%m" t) :: Int) - 1 + year = F.formatTime dtl "%Y" t + +-- | parseHistorical takes the raw csv from Yahoo Finance and returns +-- a list of HistoricalQuote entries. +parseHistorical :: QuoteSymbol -> QuoteCSV -> Maybe [HistoricalQuote] +parseHistorical symbol' csv = + let l = reverse $ map (S.split ",") $ + (tail . lines) $ filter (\c -> notElem c "\r") csv in + Just $ map (makeHistoricalQuote) l + where + -- Create a HistoricalQuote entry from a line from the csv. + makeHistoricalQuote :: [String] -> HistoricalQuote + makeHistoricalQuote l = + case (length l == 7) of + False -> error("malformed line:" ++ (show l)) + True -> let date' = makeDay (l!!0) + open' = read (l!!1) :: QuoteCurrency + high' = read (l!!2) :: QuoteCurrency + low' = read (l!!3) :: QuoteCurrency + close' = read (l!!4) :: QuoteCurrency + adjclose' = read (l!!6) :: QuoteCurrency + volume' = read (l!!5) :: Int + in HistoricalQuote { symbol = symbol', + date = date', + open = open', + high = high', + low = low', + close = close', + adjclose = adjclose', + volume = volume' } + where + -- Create a Day type from the str date from the csv. + makeDay :: String -> T.Day + makeDay s = + let a = S.split "-" s in + case (length a == 3) of + False -> error("date field " ++ s ++ " malformed") + True -> let y = read (a!!0) :: Integer + m = read (a!!1) :: Int + d = read (a!!2) :: Int in + T.fromGregorian y m d + +-- | getHistoricalQuote takes a stock symbol and a start and end dates +-- and obtains the HistoricalQuote lines for this given range. +-- Nothing is returned on any error. Check finance.yahoo.com to see how +-- far they offer quote history for a symbol you are interested in. +-- Note! Yahoo takes some liberties with dates due to weekends and +-- holidays and market closures. Exported. -- --- \[\[(\"s\",\"^DJI\"),(\"c\",\"13,500\")\], --- \[(\"s\",\"YHOO\"),(\"c\",\"27.00\")\]\] +-- Here is what a sample result looks like for one day in the history: -- --- As this function is in the Maybe Monad, Nothing is returned on an error. -getQuote :: [QuoteSymbol] -> [QuoteField] -> - IO (Maybe [[(QuoteField,QuoteValue)]]) -getQuote symbols fields = - let s = (quoteReq symbols fields) in - case U.parseURI s of - Nothing -> return Nothing - Just uri -> do - trycsv <- H.httpGet uri +-- HistoricalQuote \{symbol \= \"YHOO\", +-- date \= 2007-07-02\, +-- open \= 27.19\, +-- high \= 27.27\, +-- low \= 26.76\, +-- close \= 26.86\, +-- adjclose \= 26.86\, +-- volume \= 21011000\} +-- +getHistoricalQuote :: QuoteSymbol -> T.Day -> T.Day -> + IO (Maybe [HistoricalQuote]) +getHistoricalQuote symbol start end = + case end > start of + False -> error("start date must be earlier than end date") + True -> do + trycsv <- fetchCSV (historicalQuoteReq symbol start end) case trycsv of Nothing -> return Nothing - Just csv -> - return (Just (map (zip fields) - (map (S.split ",") - (lines (S.replace "\r" "" - (S.replace "\"" "" csv)))))) - + Just csv -> return $ parseHistorical symbol csv