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

-- a predicate defining valid queries
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)


{- Convenience functions for building queries -}
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' is a convenience function for building queries with
--   the default values.
simpleQuery :: 
  UserString -- ^ Application ID
  -> UserString -- ^ Query string
  -> Int -- ^ Number of results to return
  -> Query
simpleQuery appId queryString nr = 
  simpleQuery' appId queryString Nothing nr

-- | 'contextQuery' is a convenience function for building context queries
--   with the default values.
contextQuery :: 
  UserString -- ^ Application ID
  -> UserString -- ^ Query string
  -> UserString -- ^ Context string
  -> Int -- ^ Number of results to return
  -> Query
contextQuery appId queryString ctx nr = 
  simpleQuery' appId queryString (Just ctx) nr

{- Resource URLs -}
webQueryBase :: String
webQueryBase = "http://search.yahooapis.com/WebSearchService/V1/webSearch?"

contextQueryBase :: String
contextQueryBase = "http://search.yahooapis.com/WebSearchService/V1/contextSearch?"