module MediaWiki.API.Query.UserInfo.Import where
import MediaWiki.API.Types
import MediaWiki.API.Utils
import MediaWiki.API.Query.UserInfo
import Text.XML.Light.Types
import Text.XML.Light.Proc ( strContent )
import Control.Monad
import Data.Maybe
stringXml :: String -> Either (String,[String]) UserInfoResponse
stringXml s = parseDoc xml s
xml :: Element -> Maybe UserInfoResponse
xml e = do
guard (elName e == nsName "api")
p0 <- pNode "query" (children e)
p <- pNode "userinfo" (children p0)
let es = children p
let grps = mapMaybe xmlGroup es
let rs = mapMaybe xmlRights es
let os = mapMaybe xmlOption es
let rs1 = mapMaybe xmlRateLimit es
let ec = pAttr "editcount" p >>= readMb
let nm = fromMaybe nullUser $ pAttr "name" p
let uid = fromMaybe "0" $ pAttr "id" p >>= readMb
let isa = isJust (pAttr "anon" p)
let hasm = isJust (pAttr "mesages" p)
let bi = xmlBlockInfo p
let u = emptyUserInfo
{ uiName = nm
, uiId = uid
, uiIsAnon = isa
, uiHasMessage = hasm
, uiBlocked = bi
, uiGroups = concat grps
, uiRights = concat rs
, uiOptions = concat os
, uiRateLimits = concat rs1
, uiEditCount = ec
}
return emptyUserInfoResponse{uiUser=u}
xmlBlockInfo :: Element -> Maybe (String,String)
xmlBlockInfo e = do
b <- pAttr "blockedby" e
c <- pAttr "blockreason" e
return (b,c)
xmlGroup :: Element -> Maybe [String]
xmlGroup e = do
guard (elName e == nsName "groups")
let es = children e
let gs = mapMaybe xmlG es
return gs
where
xmlG g = do
guard (elName e == nsName "g")
return (strContent g)
xmlRights :: Element -> Maybe [String]
xmlRights e = do
guard (elName e == nsName "rights")
let es = children e
let gs = mapMaybe xmlR es
return gs
where
xmlR g = do
guard (elName e == nsName "r")
return (strContent g)
xmlRateLimit :: Element -> Maybe [RateLimit]
xmlRateLimit e = do
guard (elName e == nsName "ratelimits")
let es = children e
let gs = mapMaybe xmlR es
return gs
where
xmlR g = do
let es = children g
p <- pNode "ip" es
let hi = fromMaybe 0 $ pAttr "hits" p >>= readMb
let se = fromMaybe 0 $ pAttr "seconds" p >>= readMb
return RateLimit{rlName=qName (elName e),rlHits=hi,rlSeconds=se}
xmlOption :: Element -> Maybe [(String,String)]
xmlOption e = do
guard (elName e == nsName "options")
return (map (\a -> (qName (attrKey a), attrVal a)) (elAttribs e))