module Text.Yahoo.InternalXml
  ( buildResultSet
  , getElemCData ) where

import Text.XML.Light.Types 
  (Content(..), qName, attrKey, attrVal, elAttribs, 
    elContent, elName, cdData)

import Text.XML.Light.Cursor 
  (Cursor, current, findChild, findRight, firstChild)

import Text.Yahoo.Types

{- Functions for manipulating XML responses -}
getElemAttrVal :: (String -> a) -> Cursor -> String -> Either Error a
getElemAttrVal f c s =
  case current c of
    (Elem e) ->
      let attrs = filter ((== s) . qName . attrKey) (elAttribs e) in
      case attrs of
        (a:_) -> Right (f $ attrVal a)
        [] -> Left ("Expected attribute " ++ s, Just c)
    _ -> Left ("Expected Elem", Just c)

getElemCData :: (String -> a) -> Cursor -> Either Error a
getElemCData f c = 
  case current c of
    (Elem e) -> case elContent e of
       [Text c'] -> Right (f $ cdData c')
       _ -> Left ("Expected Text", Just c)
    _ -> Left ("Expected Elem", Just c)

nameIs :: String -> Cursor -> Bool
nameIs s c = case current c of
  (Elem e) -> ((== s) . qName . elName) e
  _ -> False

getChildElemCData :: (String -> a) -> Cursor -> String -> Either Error a
getChildElemCData f c s = 
  case (findChild (nameIs s) c) of
    (Just c') -> getElemCData f c'
    Nothing -> Left ("Expected child " ++ s, Just c)
    
--buildCache is underspecified; should be called on Cache elems only
buildCache :: Cursor -> Either Error (URL,Size)
buildCache c =
  case getChildElemCData id c "Url" of
    (Right url') -> case getChildElemCData (read :: String -> Size) c "Size" of
      (Right size') -> Right (url', size')
      (Left err) -> Left err
    (Left err) -> Left err

--buildResult is underspecified; should be called on Result elems only
buildResult :: Cursor -> Either Error Result
buildResult c =
  let getCData = getChildElemCData id c in
  case getCData "Title" of
    (Right title') -> case getCData "Summary" of
      (Right summary') -> case getCData "Url" of
        (Right url') -> case getCData "ClickUrl" of
          (Right clickUrl') -> 
            let mimeType' = case getChildElemCData id c "MimeType" of
                  (Right mt) -> Just mt
                  (Left _) -> Nothing in
            let modDate' = case getChildElemCData id c "ModificationDate" of
                  (Right md) -> Just md
                  (Left _) -> Nothing in
            let cache' = case findChild (nameIs "Cache") c of
                  (Just c1) -> case buildCache c1 of
                     (Right c2) -> Just c2
                     (Left _) -> Nothing
                  Nothing -> Nothing in          
            Right (Result title' summary' url' clickUrl'
                       mimeType' modDate' cache')
          (Left e) -> (Left e)
        (Left e) -> (Left e)
      (Left e) -> (Left e)
    (Left e) -> (Left e)

buildResults :: Cursor -> Either Error [Result]
buildResults c =  case (findRight (nameIs "Result") c) of
  (Just c2) -> case buildResult c2 of
     (Right r) -> case buildResults c2 of
       (Right r') -> Right (r : r')
       (Left e) -> (Left e)
     (Left e) -> (Left e)
  Nothing -> Right []

buildResultSet :: Cursor -> Either Error ResultSet
buildResultSet c = 
  case getElemAttrVal (read :: String -> Integer) c 
          "totalResultsAvailable" of
    (Right totResAvail) -> 
       case getElemAttrVal (read :: String -> Int) c 
               "totalResultsReturned" of
         (Right totResRet) -> case getElemAttrVal (read :: String -> Integer) c 
                                       "firstResultPosition" of
           (Right firstResPos) -> 
             case firstChild c of
               (Just fc) -> 
                 let k = case buildResult fc of
                                 (Right r) -> ((:) r)
                                 (Left _) -> id
                 in
                 case buildResults fc of
                      (Right results') -> 
                         Right (ResultSet totResAvail totResRet firstResPos (k results'))
                      (Left e) -> (Left e)
               -- on no results, just return an empty list, not an error
               Nothing -> Right (ResultSet totResAvail totResRet firstResPos [])
           (Left e) -> (Left e)
         (Left e) -> (Left e)
    (Left e) -> (Left e)