module MediaWiki.API
( module MediaWiki.API
, URLString
) where
import MediaWiki.API.Base
import MediaWiki.API.Types
import MediaWiki.API.Output
import MediaWiki.Util.Fetch as Fetch
import Codec.MIME.Type
import MediaWiki.API.Query.SiteInfo as SI
import MediaWiki.API.Query.SiteInfo.Import as SI
import MediaWiki.API.Action.Login.Import as Login
import Data.Maybe
import Control.Exception as CE
import Data.Typeable
import MediaWiki.API.Utils
import Text.XML.Light.Types
import Control.Monad
webGet :: URLString -> Request -> IO String
webGet url req = do
let url_q = url ++ "api.php?" ++ showRequest req
readContentsURL url_q
webPost :: Maybe Fetch.User -> URLString -> String -> Request -> IO ([(String,String)], String)
webPost mbUser url act req = do
let url_q = url ++ "api.php?action="++act
let pload = showRequest req
postContentsURL mbUser url_q
[ ("Content-Length", show $ length pload)
, ("Content-Type", showMIMEType form_mime_ty)
]
pload
where
form_mime_ty = Application "x-www-form-urlencoded"
webPostXml :: (String -> Either (String,[String]) a)
-> Maybe Fetch.User
-> URLString
-> String
-> Request
-> IO (Maybe a)
webPostXml p mbUser url act req = do
(hs,mb) <- webPost mbUser url act req
case mb of
"" -> return Nothing
ls -> do
case p ls of
Left (x,errs) ->
case parseError ls of
Right e -> throwMWError e
_ -> putStrLn (x ++ ':':' ':unlines errs) >> return Nothing
Right x -> return (Just x)
webGetXml :: (String -> Either (String,[String]) a)
-> URLString
-> Request
-> IO (Maybe a)
webGetXml p url req = do
ls <- webGet url req
case p ls of
Left (x,errs) ->
case parseError ls of
Right e -> throwMWError e
_ -> putStrLn (x ++ ':':' ':unlines errs) >> return Nothing
Right x -> return (Just x)
queryPage :: PageName -> QueryRequest
queryPage pg = emptyQuery{quTitles=[pg]}
mkQueryAction :: APIRequest a => QueryRequest -> a -> Action
mkQueryAction q qr =
case queryKind qr of
QProp s -> Query q{quProps=(PropKind s):quProps q} (toReq qr)
QList s -> Query q{quLists=(ListKind s):quLists q} (toReq qr)
QMeta s -> Query q{quMetas=(MetaKind s):quMetas q} (toReq qr)
QGen s -> Query q{quGenerator=(Just (GeneratorKind s))} (toReq qr)
loginWiki :: URLString -> String -> String -> IO (Maybe LoginResponse)
loginWiki url usr pwd = webPostXml Login.stringXml Nothing url "login" req
where
req = emptyXmlRequest (Login (emptyLogin usr pwd))
queryInfo :: URLString -> PageName -> IO String
queryInfo url pgName = webGet url req
where
req = emptyXmlRequest (mkQueryAction (queryPage pgName) infoRequest)
querySiteIWInfo :: URLString -> IO (Maybe SiteInfoResponse)
querySiteIWInfo url = webGetXml SI.stringXml url req
where
req = emptyXmlRequest
(mkQueryAction (queryPage "XP")
siteInfoRequest{siProp=["interwikimap"]})
queryLangPage :: URLString -> PageName -> Maybe String -> IO String
queryLangPage url pgName mb = webGet url req
where
req = emptyXmlRequest
(mkQueryAction (queryPage pgName)
langLinksRequest{llContinueFrom=mb})
parseError :: String -> Either (String,[String]) MediaWikiError
parseError s = parseDoc xmlError s
xmlError :: Element -> Maybe MediaWikiError
xmlError e = do
guard (elName e == nsName "api")
let es1 = children e
p <- pNode "error" es1
return mwError{ mwErrorCode = fromMaybe "" $ pAttr "code" p
, mwErrorInfo = fromMaybe "" $ pAttr "info" p
}
data MediaWikiError
= MediaWikiError
{ mwErrorCode :: String
, mwErrorInfo :: String
} deriving ( Typeable )
mwError :: MediaWikiError
mwError = MediaWikiError{mwErrorCode="",mwErrorInfo=""}
data SomeMWException = forall e . Exception e => SomeMWException e
deriving Typeable
instance Show SomeMWException where
show (SomeMWException e) = show e
instance Exception SomeMWException
mwToException :: Exception e => e -> SomeException
mwToException = toException . SomeMWException
mwFromException :: Exception e => SomeException -> Maybe e
mwFromException x = do
SomeMWException a <- fromException x
cast a
instance Exception MediaWikiError where
toException = mwToException
fromException = mwFromException
handleMW :: (MediaWikiError -> IO a) -> IO a -> IO a
handleMW h e = catchMW e h
tryMW :: IO a -> IO (Either MediaWikiError a)
tryMW f = handleMW (\ x -> return (Left x)) (f >>= return.Right)
throwMWError :: MediaWikiError -> IO a
throwMWError e = throwIO e
catchMW :: IO a -> (MediaWikiError -> IO a) -> IO a
catchMW f hdlr =
CE.catch f
(\ e1 -> hdlr e1)
instance Show MediaWikiError where
show x = unlines (
[ "MediaWiki error:"
, ""
, " Code: " ++ mwErrorCode x
, " Info: " ++ mwErrorInfo x
])