module Text.Yahoo.Internal
( fromYahoo
, fromYahoo'
, fromXml'
, simpleQuery
, contextQuery
, fromXml
, getElemCData
, doGet ) where
import Text.XML.Light.Input (parseXMLDoc)
import Text.XML.Light.Cursor (Cursor, fromElement)
import Network.HTTP hiding (Result)
import Network.URI hiding (query)
import Text.Yahoo.Types
import Text.Yahoo.InternalXml
fromXml' :: (Cursor -> Either Error a) -> String -> Either Error a
fromXml' f s =
case parseXMLDoc s of
(Just xml) -> do
let c = fromElement xml
case f c of
r@(Right _) -> r
l@(Left _) -> l
Nothing -> Left ("Error: Expected XML: " ++ s, Nothing)
fromXml :: String -> Either Error ResultSet
fromXml = fromXml' buildResultSet
queryValid :: Query -> Bool
queryValid q =
numResults q <= 100
&& start q <= 1000
&& case site q of
(Just l) -> length l <= 30
Nothing -> True
fromYahoo' :: Show b => (String -> Either Error a) -> (b -> Bool)
-> String -> String -> Bool -> b
-> IO (Either Error a)
fromYahoo' f g prefixTrue prefixFalse b q = do
if g q then
let q' = (if b then prefixTrue
else prefixFalse) ++ (show q)
in
case parseURI q' of
(Just uri) -> do
r <- doGet uri
case r of
(Left err) -> return (Left err)
(Right r1) -> do return $ f r1
Nothing -> do return $ Left ("Invalid URI", Nothing)
else do return $ Left ("Invalid query", Nothing)
fromYahoo :: Bool -> Query -> IO (Either Error ResultSet)
fromYahoo = fromYahoo' fromXml queryValid contextQueryBase webQueryBase
doGet :: URI -> IO (Either Error String)
doGet uri = do
let request s = Request {rqURI = s, rqMethod = GET, rqHeaders = [], rqBody = ""}
r <- simpleHTTP (request uri)
case r of
(Left e) -> return $ Left ((show e), Nothing)
(Right r') -> case rspCode r' of
(2,0,0) -> return $ Right (rspBody r')
(4,0,0) -> return $ Left (("400: " ++ (rspReason r')), Nothing)
(4,0,3) -> return $ Left (("403: " ++ (rspReason r')), Nothing)
(5,0,3) -> return $ Left (("503: " ++ (rspReason r')), Nothing)
_ -> return $ Left (rspReason r', Nothing)
simpleQuery' :: UserString -> UserString -> Maybe UserString -> Int -> Query
simpleQuery' appId queryString ctx nr = Query
{ appid = appId
, query = queryString
, context = ctx
, region = RegionDefault
, ty = TypeAny
, numResults = nr
, start = 1
, format = FormatAny
, adult_ok = False
, similar_ok = False
, language = LanguageDefault
, country = CountryDefault
, site = Nothing
, subscription = Nothing
, license = LicenseAny }
simpleQuery ::
UserString
-> UserString
-> Int
-> Query
simpleQuery appId queryString nr =
simpleQuery' appId queryString Nothing nr
contextQuery ::
UserString
-> UserString
-> UserString
-> Int
-> Query
contextQuery appId queryString ctx nr =
simpleQuery' appId queryString (Just ctx) nr
webQueryBase :: String
webQueryBase = "http://search.yahooapis.com/WebSearchService/V1/webSearch?"
contextQueryBase :: String
contextQueryBase = "http://search.yahooapis.com/WebSearchService/V1/contextSearch?"