diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) Sigbjorn Finne 2008 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,83 @@ +module Main(main) where + +import MediaWiki.API +import MediaWiki.API.Types + +import MediaWiki.API.Query.Info +import MediaWiki.API.Query.Info.Import as I +import MediaWiki.API.Query.LangLinks +import MediaWiki.API.Query.LangLinks.Import as LL +import MediaWiki.API.Query.SiteInfo + +import System.Environment +import Data.List ( isPrefixOf ) + +mw_api_url :: String +mw_api_url = "http://en.wikipedia.org/w/" + +main :: IO () +main = do + ls <- getArgs + let + (url,pg) = + case ls of + ("WP":y:_) -> (mw_api_url,y) + (x:y:_) -> (x,y) + _ -> (mw_api_url, "Main_Page") + i <- queryInfo url pg + case I.stringXml i of + Left x -> putStrLn ("Error getting info for page " ++ pg ++ " error: " ++ show x) + Right x -> putStrLn ("Page last touched: " ++ headS (map infTouched (infPages x))) + lns <- getAll url pg [] Nothing + putStrLn ("The page " ++ pg ++ " is available in other languages:") + iwMap <- getIWUrlMap url + let + getIWUrl (x,y) = + case filter ((x==).iwPrefix) iwMap of + (a:_) -> (x,subst y (iwUrl a)) + _ -> (x,"") + let lns1 = map getIWUrl lns + putStrLn (' ':' ':unlines (map (\ (a,b) -> a ++ "=> " ++ b) lns1)) + where + subst ss x = + case spanUntil ("$1" `isPrefixOf`) x of + (as,_:_:bs) -> as ++ ss ++ subst ss bs + (as,_) -> as + +spanUntil :: ([a] -> Bool) -> [a] -> ([a],[a]) +spanUntil _ [] = ([],[]) +spanUntil p ls@(x:xs) + | p ls = ([],ls) + | otherwise = + case spanUntil p xs of + (as,bs) -> (x:as,bs) + +getAll :: String -> String -> [[(String,String)]] -> Maybe String -> IO [(String,String)] +getAll url pg acc mbCont = do +-- i <- catch (queryLangPage url pg mbCont) (\ _ -> return "") + i <- queryLangPage url pg mbCont + case LL.stringXml i of + Left{} -> return (concat $ reverse acc) + Right ll -> do + let lls = map (\ lli -> (langName lli, lTitle lli)) (concat (map snd (llPages ll))) + case llContinue ll of + Nothing -> return $ concat $ reverse (lls:acc) + Just mb -> do + getAll url pg (lls:acc) (Just mb) + where + lTitle x = + case langTitle x of + Nothing -> pg + Just "" -> pg + Just xs -> xs + +getIWUrlMap :: String -> IO [InterwikiEntry] +getIWUrlMap api_url = do + mb <- querySiteIWInfo api_url + case mb of + Nothing -> return [] + Just si -> return (siInterwiki si) + +headS :: [String] -> String +headS [] = "" +headS (x:_) = x diff --git a/MediaWiki/API.hs b/MediaWiki/API.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API.hs @@ -0,0 +1,194 @@ +{-# OPTIONS_GHC -XExistentialQuantification -XDeriveDataTypeable #-} +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API +-- Description : A Haskell MediaWiki API binding +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- A Haskell MediaWiki API binding. +-- +-------------------------------------------------------------------- +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 url req@ issues a GET to a MediaWiki server, appending +-- @api.php?@ followed by the request @req@ to the URL base @url@. +webGet :: URLString -> Request -> IO String +webGet url req = do + let url_q = url ++ "api.php?" ++ showRequest req +-- print url_q + readContentsURL url_q + +-- | @webGet mbUser url req@ issues a POST to a MediaWiki server, appending +-- @api.php?@ followed by the request @req@ to the URL base @url@. +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 u usr pass +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,[{-Error msg-}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 + } + +-- MW exceptions/errors: + +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 + ]) diff --git a/MediaWiki/API/Action/Block.hs b/MediaWiki/API/Action/Block.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Block.hs @@ -0,0 +1,63 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Block +-- Description : Representing Block requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Block requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Block where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data BlockRequest + = BlockRequest + { blkUser :: UserName + , blkToken :: Token + , blkGetToken :: Bool + , blkExpiry :: Maybe Timestamp + , blkReason :: Maybe String + , blkAnonOnly :: Bool + , blkNoCreate :: Bool + , blkAutoBlock :: Bool + , blkNoEmail :: Bool + , blkHide :: Bool + } + +instance APIRequest BlockRequest where + isPostable _ = True + showReq r = + [ opt "user" (blkUser r) + , opt "token" (blkToken r) + , optB "gettoken" (blkGetToken r) + , mbOpt "expiry" id (blkExpiry r) + , mbOpt "reason" id (blkReason r) + , optB "anononly" (blkAnonOnly r) + , optB "nocreate" (blkNoCreate r) + , optB "autoblock" (blkAutoBlock r) + , optB "noemail" (blkNoEmail r) + , optB "hidename" (blkHide r) + ] + + +emptyBlockRequest :: BlockRequest +emptyBlockRequest = BlockRequest + { blkUser = "" + , blkToken = "" + , blkGetToken = False + , blkExpiry = Nothing + , blkReason = Nothing + , blkAnonOnly = False + , blkNoCreate = False + , blkAutoBlock = False + , blkNoEmail = False + , blkHide = False + } + diff --git a/MediaWiki/API/Action/Delete.hs b/MediaWiki/API/Action/Delete.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Delete.hs @@ -0,0 +1,50 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Delete +-- Description : Representing Delete requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Delete requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Delete where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data DeleteRequest + = DeleteRequest + { delTitle :: PageName + , delToken :: Token + , delReason :: Maybe String + , delWatch :: Maybe Bool + , delUnwatch :: Maybe Bool + , delOldImage :: Maybe String + } + +instance APIRequest DeleteRequest where + isPostable _ = True + showReq r = + [ opt "title" (delTitle r) + , opt "token" (delToken r) + , mbOpt "reason" id (delReason r) + , optB "watch" (fromMaybe False $ delWatch r) + , optB "unwatch" (fromMaybe False $ delUnwatch r) + , mbOpt "oldimage" id (delOldImage r) + ] + +emptyDeleteRequest :: DeleteRequest +emptyDeleteRequest = DeleteRequest + { delTitle = "" + , delToken = "" + , delReason = Nothing + , delWatch = Nothing + , delUnwatch = Nothing + , delOldImage = Nothing + } + diff --git a/MediaWiki/API/Action/Edit.hs b/MediaWiki/API/Action/Edit.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Edit.hs @@ -0,0 +1,90 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Edit +-- Description : Representing Edit requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Edit requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Edit where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data EditRequest + = EditRequest + { edTitle :: Maybe PageName + , edSection :: Maybe String + , edText :: Maybe String -- ^ Page content + , edToken :: Maybe Token -- ^ Edit token. You can get one of these through prop=info + , edSummary :: Maybe String + , edIsMinor :: Bool + , edIsNonMinor :: Bool + , edAsBot :: Bool + , edBaseTimestamp :: Maybe Timestamp + , edRecreate :: Bool + , edCreateOnly :: Bool + , edNoCreate :: Bool + , edCaptchaWord :: Maybe String + , edCaptchaId :: Maybe String + , edWatch :: Bool + , edUnwatch :: Bool + , edMD5 :: Maybe String + , edPrependText :: Maybe String + , edAppendText :: Maybe String + } + +instance APIRequest EditRequest where + isPostable _ = True + showReq r = + [ mbOpt "title" id (edTitle r) + , mbOpt "section" id (edSection r) + , mbOpt "text" id (edText r) + , mbOpt "token" id (edToken r) + , mbOpt "summary" id (edSummary r) + , optB "minor" (edIsMinor r) + , optB "notminor" (edIsNonMinor r) + , optB "bot" (edAsBot r) + , mbOpt "basetimestamp" id (edBaseTimestamp r) + , optB "recreate" (edRecreate r) + , optB "createonly" (edCreateOnly r) + , optB "nocreate" (edNoCreate r) + , mbOpt "captchaword" id (edCaptchaWord r) + , mbOpt "captchaid" id (edCaptchaId r) + , optB "watch" (edWatch r) + , optB "unwatch" (edUnwatch r) + , mbOpt "md5" id (edMD5 r) + , mbOpt "prependtext" id (edPrependText r) + , mbOpt "appendtext" id (edAppendText r) + ] + + +emptyEditRequest :: EditRequest +emptyEditRequest = EditRequest + { edTitle = Nothing + , edSection = Nothing + , edText = Nothing + , edToken = Nothing + , edSummary = Nothing + , edIsMinor = False + , edIsNonMinor = True + , edAsBot = False + , edBaseTimestamp = Nothing + , edRecreate = False + , edCreateOnly = False + , edNoCreate = False + , edCaptchaWord = Nothing + , edCaptchaId = Nothing + , edWatch = False + , edUnwatch = False + , edMD5 = Nothing + , edPrependText = Nothing + , edAppendText = Nothing + } + diff --git a/MediaWiki/API/Action/EmailUser.hs b/MediaWiki/API/Action/EmailUser.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/EmailUser.hs @@ -0,0 +1,46 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.EmailUser +-- Description : Representing EmailUser requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing EmailUser requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.EmailUser where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data EmailUserRequest + = EmailUserRequest + { emTarget :: Maybe String + , emSubject :: Maybe String + , emText :: Maybe String + , emToken :: Maybe Token + , emCcMe :: Bool + } + +instance APIRequest EmailUserRequest where + isPostable _ = True + showReq r = + [ mbOpt "target" id (emTarget r) + , mbOpt "subject" id (emSubject r) + , mbOpt "text" id (emText r) + , mbOpt "token" id (emToken r) + , optB "ccme" (emCcMe r) + ] + +emptyEmailUserRequest :: EmailUserRequest +emptyEmailUserRequest = EmailUserRequest + { emTarget = Nothing + , emSubject = Nothing + , emText = Nothing + , emToken = Nothing + , emCcMe = False + } diff --git a/MediaWiki/API/Action/ExpandTemplates.hs b/MediaWiki/API/Action/ExpandTemplates.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/ExpandTemplates.hs @@ -0,0 +1,44 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.ExpandTemplates +-- Description : Representing ExpandTemplates requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing ExpandTemplates requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.ExpandTemplates where + +import MediaWiki.API.Types + +data ExpandTemplatesRequest + = ExpandTemplatesRequest + { etTitle :: Maybe PageName + , etText :: String + , etGenXml :: Maybe Bool + } + +emptyExpandTemplatesRequest :: ExpandTemplatesRequest +emptyExpandTemplatesRequest = ExpandTemplatesRequest + { etTitle = Nothing + , etText = "" + , etGenXml = Nothing + } + +data ExpandTemplatesResponse + = ExpandTemplatesResponse + { etExpandedText :: String + , etExpandedXml :: Maybe String + } + +emptyExpandTemplatesResponse :: ExpandTemplatesResponse +emptyExpandTemplatesResponse = ExpandTemplatesResponse + { etExpandedText = "" + , etExpandedXml = Nothing + } + diff --git a/MediaWiki/API/Action/ExpandTemplates/Import.hs b/MediaWiki/API/Action/ExpandTemplates/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/ExpandTemplates/Import.hs @@ -0,0 +1,39 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.ExpandTemplates.Import +-- Description : Serializing ExpandTemplates requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Serializing ExpandTemplates requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.ExpandTemplates.Import where + +--import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Action.ExpandTemplates + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ExpandTemplatesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ExpandTemplatesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "expandtemplates" es1 + let xm = fmap strContent $ pNode "parsetree" es1 + return emptyExpandTemplatesResponse + { etExpandedText = strContent p + , etExpandedXml = xm + } diff --git a/MediaWiki/API/Action/FeedWatchlist.hs b/MediaWiki/API/Action/FeedWatchlist.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/FeedWatchlist.hs @@ -0,0 +1,49 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.FeedWatchlist +-- Description : Representing FeedWatchList requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing FeedWatchList requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.FeedWatchlist where + +import MediaWiki.API.Types + +data FeedWatchListRequest + = FeedWatchListRequest + { feAsAtom :: Bool -- False => rss + , feHours :: Maybe Int + , feAllRev :: Bool + } + +emptyFeedWatchListRequest :: FeedWatchListRequest +emptyFeedWatchListRequest = FeedWatchListRequest + { feAsAtom = False + , feHours = Nothing + , feAllRev = False + } + +data FeedWatchListResponse + = FeedWatchListResponse + { fwFeedFormat :: String + , fwFeedRaw :: String + , fwFeedItems :: [FeedItem] + } + +data FeedItem + = FeedItem + { fiTitle :: String + , fiUrl :: URLString + , fiComment :: String + , fiTimestamp :: String + , fiUser :: String + , fiText :: String + } + diff --git a/MediaWiki/API/Action/Login.hs b/MediaWiki/API/Action/Login.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Login.hs @@ -0,0 +1,67 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Login +-- Description : Representing Login requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Login requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Login where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data LoginRequest + = LoginRequest + { lgName :: User + , lgPassword :: Password + , lgDomain :: Maybe String + } + +instance APIRequest LoginRequest where + isPostable _ = True + showReq r = + [ opt "lgname" (lgName r) + , opt "lgpassword" (lgPassword r) + , mbOpt "lgdomain" id (lgDomain r) + ] + +emptyLogin :: User -> Password -> LoginRequest +emptyLogin u p + = LoginRequest + { lgName = u + , lgPassword = p + , lgDomain = Nothing + } + +data LoginResponse + -- error responses, all together: + = LoginError + { lgSuccess :: Bool + , lgeError :: String -- NeedToWait/NoName/Illegal/WrongPluginPass/NotExists/WrongPass/EmptyPass/future ones. + -- (resist the temptation(?) to encode errors via a separate type, keep it loose for now in a String. + , lgeDetails :: Maybe String + , lgeWait :: String + } + -- Successfully logged in, bundle up the result in a separate record so as to ease + -- the carrying around of a user session. + -- + -- Notice the use of a shared boolean field betw. the constructors; eases the processing of + -- responses in code where conds/guards are more convenient: + -- + -- x <- submitLoginRequest lgReq + -- when (not $ lgSuccess x) (handleError x) + -- let sess = lgSession x + -- ... + -- + | LoginResponse + { lgSuccess :: Bool + , lgSession :: UserSession + } + diff --git a/MediaWiki/API/Action/Login/Import.hs b/MediaWiki/API/Action/Login/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Login/Import.hs @@ -0,0 +1,61 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Login.Import +-- Description : Serializing Login requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Serializing Login requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Login.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Action.Login + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) LoginResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe LoginResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "login" es1 + let res = pAttr "result" p + let uid = pAttr "lguserid" p + let unm = pAttr "lgusername" p + let tok = pAttr "lgtoken" p + let coo = pAttr "cookieprefix" p + let ses = pAttr "sessionid" p + case res of + Just "Success" -> + return LoginResponse{ lgSuccess=True + , lgSession=UserSession + { sessUserId = fromMaybe "" uid + , sessUserName = fromMaybe "" unm + , sessPassword = Nothing + , sessCookiePrefix = coo + , sessSessionId = ses + , sessToken = fromMaybe "" tok + }} + Just x -> do + let det = pAttr "details" p + let wai = pAttr "wait" p + return LoginError + { lgSuccess = False + , lgeError = x + , lgeDetails = det + , lgeWait = fromMaybe "" wai + } + diff --git a/MediaWiki/API/Action/Move.hs b/MediaWiki/API/Action/Move.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Move.hs @@ -0,0 +1,57 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Move +-- Description : Representing Move requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Move requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Move where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data MoveRequest + = MoveRequest + { mvFrom :: Maybe PageName + , mvTo :: Maybe PageName + , mvToken :: Token + , mvReason :: Maybe String + , mvMoveTalk :: Bool + , mvNoRedir :: Bool + , mvWatch :: Bool + , mvUnwatch :: Bool + } + +instance APIRequest MoveRequest where + isPostable _ = True + showReq r = + [ mbOpt "from" id (mvFrom r) + , mbOpt "to" id (mvTo r) + , opt "token" (mvToken r) + , mbOpt "reason" id (mvReason r) + , optB "movetalk" (mvMoveTalk r) + , optB "noredirect" (mvNoRedir r) + , optB "watch" (mvWatch r) + , optB "unwatch" (mvUnwatch r) + ] + + +emptyMoveRequest :: MoveRequest +emptyMoveRequest = MoveRequest + { mvFrom = Nothing + , mvTo = Nothing + , mvToken = "" + , mvReason = Nothing + , mvMoveTalk = False + , mvNoRedir = False + , mvWatch = False + , mvUnwatch = False + } + diff --git a/MediaWiki/API/Action/OpenSearch.hs b/MediaWiki/API/Action/OpenSearch.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/OpenSearch.hs @@ -0,0 +1,44 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.OpenSearch +-- Description : Representing OpenSearch requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing OpenSearch requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.OpenSearch where + +import MediaWiki.API.Types + +data OpenSearchRequest + = OpenSearchRequest + { osSearch :: String + , osLimit :: Maybe Int + , osNamespaces :: Maybe [Int] + } + +emptyOpenSearchRequest :: String -> OpenSearchRequest +emptyOpenSearchRequest tit + = OpenSearchRequest + { osSearch = tit + , osLimit = Nothing + , osNamespaces = Nothing + } + +data OpenSearchResponse + = OpenSearchResponse + { osHits :: [OpenSearchHit] + } + +data OpenSearchHit + = OpenSearchHit + { oshTitle :: String + , oshMatches :: [String] + } + diff --git a/MediaWiki/API/Action/ParamInfo.hs b/MediaWiki/API/Action/ParamInfo.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/ParamInfo.hs @@ -0,0 +1,59 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.ParamInfo +-- Description : Representing ParamInfo requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing ParamInfo requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.ParamInfo where + +import MediaWiki.API.Types + +data ParamInfoRequest + = ParamInfoRequest + { paModules :: [String] + , paQueryModules :: [String] + } + +emptyParamInfoRequest :: ParamInfoRequest +emptyParamInfoRequest = ParamInfoRequest + { paModules = [] + , paQueryModules = [] + } + +data ParamInfoResponse + = ParamInfoResponse + { parModules :: [APIModule] + } + +data APIModule + = APIModule + { modName :: String + , modClass :: String + , modDescription :: String + , modParams :: [ModuleParam] + } + +data ModuleParam + = ModuleParam + { modParamName :: String + , modParamDefault :: String + , modParamDescription :: String + , modParamPrefix :: String + , modParamType :: ParamType + } + +data ParamType + = TypeBool + | TypeString + | TypeInteger + | TypeTimestamp + | TypeName String + | TypeEnum [String] diff --git a/MediaWiki/API/Action/Parse.hs b/MediaWiki/API/Action/Parse.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Parse.hs @@ -0,0 +1,89 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Parse +-- Description : Representing Parse requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Parse requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Parse where + +import MediaWiki.API.Types + +data ParseRequest + = ParseRequest + { paTitle :: Maybe PageName + , paText :: String + , paPage :: Maybe PageName + , paOldId :: Maybe RevID + , paProp :: [String] + } + +emptyParseRequest :: String -> ParseRequest +emptyParseRequest txt = ParseRequest + { paTitle = Nothing + , paText = txt + , paPage = Nothing + , paOldId = Nothing + , paProp = [] + } + +data ParseResponse + = ParseResponse + { parText :: String + , parRevId :: Maybe RevID + , parLangLinks :: Maybe [LanguageLink] + , parCategories :: Maybe [CategoryLink] + , parLinks :: Maybe [Link] + , parTemplates :: Maybe [Link] + , parImages :: Maybe [String] + , parExternalLinks :: Maybe [URLString] + , parSections :: Maybe [TOCSection] + } + +emptyParseResponse :: ParseResponse +emptyParseResponse = ParseResponse + { parText = "" + , parRevId = Nothing + , parLangLinks = Nothing + , parCategories = Nothing + , parLinks = Nothing + , parTemplates = Nothing + , parImages = Nothing + , parExternalLinks = Nothing + , parSections = Nothing + } + +data LanguageLink + = LanguageLink + { laLang :: String + , laLink :: String + } + +data CategoryLink + = CategoryLink + { caSortKey :: String + , caLink :: String + } + +data Link + = Link + { liNamespace :: String + , liExists :: Bool + , liLink :: String + } + +data TOCSection + = TOCSection + { tocTocLevel :: Int + , tocLevel :: Int + , tocLine :: String + , tocNumber :: String + } + diff --git a/MediaWiki/API/Action/Parse/Import.hs b/MediaWiki/API/Action/Parse/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Parse/Import.hs @@ -0,0 +1,102 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Parse.Import +-- Description : Serializing Parse requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Serializing Parse requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Parse.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Action.Parse + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ParseResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ParseResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "parse" es1 + let es = children p + let txt = fromMaybe "" (pNode "text" es >>= return.strContent) + let rev = pAttr "revid" p + let ll = fmap (mapMaybe xmlLL) (fmap children $ pNode "langlinks" es) + let ca = fmap (mapMaybe xmlCat) (fmap children $ pNode "categories" es) + let li = fmap (mapMaybe xmlLi) (fmap children $ pNode "links" es) + let te = fmap (mapMaybe xmlTe) (fmap children $ pNode "templates" es) + let im = fmap (mapMaybe xmlIm) (fmap children $ pNode "images" es) + let ex = fmap (mapMaybe xmlEx) (fmap children $ pNode "externallinks" es) + let se = fmap (mapMaybe xmlSe) (fmap children $ pNode "sections" es) + return emptyParseResponse + { parText = txt + , parRevId = rev + , parLangLinks = ll + , parCategories = ca + , parLinks = li + , parTemplates = te + , parImages = im + , parExternalLinks = ex + , parSections = se + } + +xmlLL :: Element -> Maybe LanguageLink +xmlLL e = do + guard (elName e == nsName "ll") + let lng = fromMaybe "en" $ pAttr "lang" e + return LanguageLink{laLang=lng,laLink=strContent e} + +xmlCat :: Element -> Maybe CategoryLink +xmlCat e = do + guard (elName e == nsName "cl") + let sk = fromMaybe "" $ pAttr "sortkey" e + return CategoryLink{caSortKey=sk,caLink=strContent e} + +xmlLi :: Element -> Maybe Link +xmlLi e = do + guard (elName e == nsName "pl") + let ex = isJust (pAttr "exists" e) + let ns = fromMaybe mainNamespace $ pAttr "ns" e + return Link{liNamespace=ns,liExists=ex,liLink=strContent e} + + +xmlTe :: Element -> Maybe Link +xmlTe e = do + guard (elName e == nsName "tl") + let ex = isJust (pAttr "exists" e) + let ns = fromMaybe mainNamespace $ pAttr "ns" e + return Link{liNamespace=ns,liExists=ex,liLink=strContent e} + +xmlIm :: Element -> Maybe URLString +xmlIm e = do + guard (elName e == nsName "img") + return (strContent e) + +xmlEx :: Element -> Maybe URLString +xmlEx e = do + guard (elName e == nsName "el") + return (strContent e) + +xmlSe :: Element -> Maybe TOCSection +xmlSe e = do + guard (elName e == nsName "s") + let tlev = fromMaybe 0 $ pAttr "toclevel" e >>= readMb + let lev = fromMaybe 0 $ pAttr "level" e >>= readMb + let lin = fromMaybe "" $ pAttr "line" e + let num = fromMaybe "" $ pAttr "number" e + return TOCSection{tocTocLevel=tlev,tocLevel=lev,tocLine=lin,tocNumber=num} + diff --git a/MediaWiki/API/Action/Protect.hs b/MediaWiki/API/Action/Protect.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Protect.hs @@ -0,0 +1,50 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Protect +-- Description : Representing Protect requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Protect requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Protect where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ProtectRequest + = ProtectRequest + { protTitle :: PageName + , protToken :: Token + , protProtections :: [(String,String)] + , protExpiry :: Maybe Timestamp + , protReason :: Maybe String + , protCascade :: Maybe Bool + } + +instance APIRequest ProtectRequest where + isPostable _ = True + showReq r = + [ opt "title" (protTitle r) + , opt "token" (protToken r) + , opt1 "protections" (map (\ (a,b) -> a ++ '=':b) (protProtections r)) + , mbOpt "expiry" id (protExpiry r) + , mbOpt "reason" id (protReason r) + , optB "cascade" (fromMaybe False $ protCascade r) + ] + +emptyProtectRequest :: ProtectRequest +emptyProtectRequest = ProtectRequest + { protTitle = "" + , protToken = "" + , protProtections = [] + , protExpiry = Nothing + , protReason = Nothing + , protCascade = Nothing + } + diff --git a/MediaWiki/API/Action/Rollback.hs b/MediaWiki/API/Action/Rollback.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Rollback.hs @@ -0,0 +1,47 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Rollback +-- Description : Representing Rollback requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Rollback requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Rollback where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data RollbackRequest + = RollbackRequest + { rbTitle :: PageName + , rbUser :: UserName + , rbToken :: Token + , rbSummary :: Maybe String + , rbMarkBot :: Maybe Bool + } + +instance APIRequest RollbackRequest where + isPostable _ = True + showReq r = + [ opt "title" (rbTitle r) + , opt "user" (rbUser r) + , opt "token" (rbToken r) + , mbOpt "summary" id (rbSummary r) + , mbOpt "markbot" (\ x -> if x then "1" else "0") (rbMarkBot r) + ] + +emptyRollbackRequest :: RollbackRequest +emptyRollbackRequest = RollbackRequest + { rbTitle = "" + , rbUser = "" + , rbToken = "" + , rbSummary = Nothing + , rbMarkBot = Nothing + } + diff --git a/MediaWiki/API/Action/Sitematrix.hs b/MediaWiki/API/Action/Sitematrix.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Sitematrix.hs @@ -0,0 +1,48 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Sitematrix +-- Description : Representing Sitematrix requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Sitematrix requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Sitematrix where + +import MediaWiki.API.Types + +-- 1.12+ and later +data SitematrixRequest + = SitematrixRequest + +emptySitematrixRequest :: SitematrixRequest +emptySitematrixRequest = SitematrixRequest + +data SitematrixResponse + = SitematrixResponse + { smCount :: Int + , smSpecials :: [SiteSpecialInfo] + , smLanguages :: [LanguageInfo] + } + +data SiteSpecialInfo + = SiteSpecialInfo + { siCode :: String + , siUrl :: URLString + } + +data LanguageInfo + = LanguageInfo + { liCode :: String + , liName :: String + , liSites :: [SiteInfos] + } + +data SiteInfos + = SiteInfos + { siInfo :: String } diff --git a/MediaWiki/API/Action/Unblock.hs b/MediaWiki/API/Action/Unblock.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Unblock.hs @@ -0,0 +1,47 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Unblock +-- Description : Representing Unblock requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Unblock requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Unblock where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data UnblockRequest + = UnblockRequest + { ublkId :: Maybe String + , ublkUser :: Maybe UserName + , ublkToken :: Maybe Token + , ublkGetToken :: Bool + , ublkReason :: Maybe String + } + +instance APIRequest UnblockRequest where + isPostable _ = True + showReq r = + [ mbOpt "id" id (ublkId r) + , mbOpt "user" id (ublkUser r) + , mbOpt "token" id (ublkToken r) + , optB "gettoken" (ublkGetToken r) + , mbOpt "reason" id (ublkReason r) + ] + +emptyUnblockRequest :: UnblockRequest +emptyUnblockRequest = UnblockRequest + { ublkId = Nothing + , ublkUser = Nothing + , ublkToken = Nothing + , ublkGetToken = False + , ublkReason = Nothing + } + diff --git a/MediaWiki/API/Action/Undelete.hs b/MediaWiki/API/Action/Undelete.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Undelete.hs @@ -0,0 +1,43 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Undelete +-- Description : Representing Undelete requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Undelete requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Undelete where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data UndeleteRequest + = UndeleteRequest + { udelTitle :: PageName + , udelToken :: Token + , udelReason :: Maybe String + , udelTimestamps :: [Timestamp] + } + +instance APIRequest UndeleteRequest where + isPostable _ = True + showReq r = + [ opt "title" (udelTitle r) + , opt "token" (udelToken r) + , mbOpt "reason" id (udelReason r) + , opt1 "timestamps" (udelTimestamps r) + ] +emptyUndeleteRequest :: UndeleteRequest +emptyUndeleteRequest = UndeleteRequest + { udelTitle = "" + , udelToken = "" + , udelReason = Nothing + , udelTimestamps = [] + } + diff --git a/MediaWiki/API/Action/Watch.hs b/MediaWiki/API/Action/Watch.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Action/Watch.hs @@ -0,0 +1,37 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Action.Watch +-- Description : Representing Watch requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing Watch requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Action.Watch where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data WatchRequest + = WatchRequest + { waTitle :: PageName + , waIsUnwatch :: Bool + } + +instance APIRequest WatchRequest where + isPostable _ = True + showReq r = + [ opt "title" (waTitle r) + , optB "unwatch" (waIsUnwatch r) + ] + +emptyWatchRequest :: WatchRequest +emptyWatchRequest = WatchRequest + { waTitle = "" + , waIsUnwatch = False + } diff --git a/MediaWiki/API/Base.hs b/MediaWiki/API/Base.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Base.hs @@ -0,0 +1,329 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Base +-- Description : Collector module of types used by the MediaWiki API +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Collector module of types used by the MediaWiki API +-- +-------------------------------------------------------------------- +module MediaWiki.API.Base + ( module MediaWiki.API.Base + , module MediaWiki.API.Query.AllCategories + , module MediaWiki.API.Query.AllImages + , module MediaWiki.API.Query.AllLinks + , module MediaWiki.API.Query.AllMessages + , module MediaWiki.API.Query.AllPages + , module MediaWiki.API.Query.AllUsers + , module MediaWiki.API.Query.BackLinks + , module MediaWiki.API.Query.Blocks + , module MediaWiki.API.Query.Categories + , module MediaWiki.API.Query.CategoryInfo + , module MediaWiki.API.Query.CategoryMembers + , module MediaWiki.API.Query.DeletedRevisions + , module MediaWiki.API.Query.EmbeddedIn + , module MediaWiki.API.Query.ExternalLinks + , module MediaWiki.API.Query.ExternalURLUsage + , module MediaWiki.API.Query.ImageInfo + , module MediaWiki.API.Query.Images + , module MediaWiki.API.Query.ImageUsage + , module MediaWiki.API.Query.Info + , module MediaWiki.API.Query.LangLinks + , module MediaWiki.API.Query.LogEvents + , module MediaWiki.API.Query.Random + , module MediaWiki.API.Query.RecentChanges + , module MediaWiki.API.Query.Revisions + , module MediaWiki.API.Query.Search + , module MediaWiki.API.Query.SiteInfo + , module MediaWiki.API.Query.Templates + , module MediaWiki.API.Query.UserContribs + , module MediaWiki.API.Query.UserInfo + , module MediaWiki.API.Query.Users + , module MediaWiki.API.Query.WatchList + + , module MediaWiki.API.Action.Login + , module MediaWiki.API.Action.ParamInfo + , module MediaWiki.API.Action.Parse + , module MediaWiki.API.Action.OpenSearch + , module MediaWiki.API.Action.FeedWatchlist + , module MediaWiki.API.Action.ExpandTemplates + , module MediaWiki.API.Action.Sitematrix + , module MediaWiki.API.Action.Unblock + , module MediaWiki.API.Action.Watch + , module MediaWiki.API.Action.EmailUser + , module MediaWiki.API.Action.Edit + , module MediaWiki.API.Action.Move + , module MediaWiki.API.Action.Block + , module MediaWiki.API.Action.Protect + , module MediaWiki.API.Action.Undelete + , module MediaWiki.API.Action.Delete + , module MediaWiki.API.Action.Rollback + + ) where + +import MediaWiki.API.Types +import MediaWiki.API.Query.AllCategories +import MediaWiki.API.Query.AllImages +import MediaWiki.API.Query.AllLinks +import MediaWiki.API.Query.AllMessages +import MediaWiki.API.Query.AllPages +import MediaWiki.API.Query.AllUsers +import MediaWiki.API.Query.BackLinks +import MediaWiki.API.Query.Blocks +import MediaWiki.API.Query.Categories +import MediaWiki.API.Query.CategoryInfo +import MediaWiki.API.Query.CategoryMembers +import MediaWiki.API.Query.DeletedRevisions +import MediaWiki.API.Query.EmbeddedIn +import MediaWiki.API.Query.ExternalLinks +import MediaWiki.API.Query.ExternalURLUsage +import MediaWiki.API.Query.ImageInfo +import MediaWiki.API.Query.Images +import MediaWiki.API.Query.ImageUsage +import MediaWiki.API.Query.Info +import MediaWiki.API.Query.LangLinks +import MediaWiki.API.Query.Links +import MediaWiki.API.Query.LogEvents +import MediaWiki.API.Query.Random +import MediaWiki.API.Query.RecentChanges +import MediaWiki.API.Query.Revisions +import MediaWiki.API.Query.Search +import MediaWiki.API.Query.SiteInfo +import MediaWiki.API.Query.Templates +import MediaWiki.API.Query.UserContribs +import MediaWiki.API.Query.UserInfo +import MediaWiki.API.Query.Users +import MediaWiki.API.Query.WatchList + +import MediaWiki.API.Action.Login +import MediaWiki.API.Action.ParamInfo +import MediaWiki.API.Action.Parse +import MediaWiki.API.Action.OpenSearch +import MediaWiki.API.Action.FeedWatchlist +import MediaWiki.API.Action.ExpandTemplates +import MediaWiki.API.Action.Sitematrix +import MediaWiki.API.Action.Unblock +import MediaWiki.API.Action.Watch +import MediaWiki.API.Action.EmailUser +import MediaWiki.API.Action.Edit +import MediaWiki.API.Action.Move +import MediaWiki.API.Action.Block +import MediaWiki.API.Action.Protect +import MediaWiki.API.Action.Undelete +import MediaWiki.API.Action.Delete +import MediaWiki.API.Action.Rollback + +-- | Type collecting together the main parts of a MediaWiki API request. +data Request + = Request + { reqAction :: Action + , reqFormat :: Format + , reqMaxLag :: Maybe Int + } + +emptyRequest :: Action -> Format -> Request +emptyRequest a f + = Request + { reqAction = a + , reqFormat = f + , reqMaxLag = Nothing + } + +emptyXmlRequest :: Action -> Request +emptyXmlRequest a = emptyRequest a xmlFormat + +data Action + = Sitematrix + | Login LoginRequest + | Logout + | Query QueryRequest [String] + | ExpandTemplates ExpandTemplatesRequest + | Parse ParseRequest + | OpenSearch OpenSearchRequest + | FeedWatch FeedWatchListRequest + | Help HelpRequest + | ParamInfo ParamInfoRequest + | Unblock UnblockRequest + | Watch WatchRequest + | EmailUser EmailUserRequest + | Edit EditRequest + | Move MoveRequest + | Block BlockRequest + | Protect ProtectRequest + | Undelete UndeleteRequest + | Delete DeleteRequest + | Rollback RollbackRequest + | OtherAction String [ValueName] + + +infoRequest :: InfoRequest +infoRequest = emptyInfoRequest + +revisionRequest :: RevisionRequest +revisionRequest = emptyRevisionRequest + +linksRequest :: LinksRequest +linksRequest = emptyLinksRequest + +langLinksRequest :: LangLinksRequest +langLinksRequest = emptyLangLinksRequest + +imagesRequest :: ImagesRequest +imagesRequest = emptyImagesRequest + +imageInfoRequest :: ImageInfoRequest +imageInfoRequest = emptyImageInfoRequest + +templatesRequest :: TemplatesRequest +templatesRequest = emptyTemplatesRequest + +categoriesRequest :: CategoriesRequest +categoriesRequest = emptyCategoriesRequest + +allCategoriesRequest :: AllCategoriesRequest +allCategoriesRequest = emptyAllCategoriesRequest + +allImagesRequest :: AllImagesRequest +allImagesRequest = emptyAllImagesRequest + +allLinksRequest :: AllLinksRequest +allLinksRequest = emptyAllLinksRequest + +allMessagesRequest :: AllMessagesRequest +allMessagesRequest = emptyAllMessagesRequest + +allPagesRequest :: AllPagesRequest +allPagesRequest = emptyAllPagesRequest + +allUsersRequest :: AllUsersRequest +allUsersRequest = emptyAllUsersRequest + +backLinksRequest :: BackLinksRequest +backLinksRequest = emptyBackLinksRequest + +embeddedInRequest :: EmbeddedInRequest +embeddedInRequest = emptyEmbeddedInRequest + +imageUsageRequest :: ImageUsageRequest +imageUsageRequest = emptyImageUsageRequest + +categoryInfoRequest :: CategoryInfoRequest +categoryInfoRequest = emptyCategoryInfoRequest + +categoryMembersRequest :: CategoryMembersRequest +categoryMembersRequest = emptyCategoryMembersRequest + +externalLinksRequest :: ExternalLinksRequest +externalLinksRequest = emptyExternalLinksRequest + +externalURLUsageRequest :: ExternalURLUsageRequest +externalURLUsageRequest = emptyExternalURLUsageRequest + +logEventsRequest :: LogEventsRequest +logEventsRequest = emptyLogEventsRequest + +recentChangesRequest :: RecentChangesRequest +recentChangesRequest = emptyRecentChangesRequest + +searchRequest :: String -> SearchRequest +searchRequest = emptySearchRequest + +siteInfoRequest :: SiteInfoRequest +siteInfoRequest = emptySiteInfoRequest + +userContribsRequest :: UserContribsRequest +userContribsRequest = emptyUserContribsRequest + +userInfoRequest :: UserInfoRequest +userInfoRequest = emptyUserInfoRequest + +watchListRequest :: WatchListRequest +watchListRequest = emptyWatchListRequest + +blocksRequest :: BlocksRequest +blocksRequest = emptyBlocksRequest + +deletedRevisionsRequest :: DeletedRevisionsRequest +deletedRevisionsRequest = emptyDeletedRevisionsRequest + +usersRequest :: UsersRequest +usersRequest = emptyUsersRequest + +randomPagesRequest :: RandomPagesRequest +randomPagesRequest = emptyRandomPagesRequest + +data QueryRequestKind + = InfoProp InfoRequest + | RevisionsProp RevisionRequest + | LinksPropProp LinksRequest + | LangLinksProp LangLinksRequest + | ImagesProp ImagesRequest + | ImageInfoProp ImageInfoRequest + | TemplatesProp TemplatesRequest + | CategoriesProp CategoriesRequest + | AllCategoriesProp AllCategoriesRequest + | AllImagesProp AllImagesRequest + | AllLinksProp AllLinksRequest + | AllMessagesProp AllMessagesRequest + | AllPagesProp AllPagesRequest + | AllUsersProp AllUsersRequest + | BacklinksProp BackLinksRequest + | EmbeddedInProp EmbeddedInRequest + | ImageUsageProp ImageUsageRequest + | CategoryInfoProp CategoryInfoRequest + | CategoryMembersProp CategoryMembersRequest + | ExternalLinksProp ExternalLinksRequest + | ExternalURLUsageProp ExternalURLUsageRequest + | LogEventsProp LogEventsRequest + | RecentChangesProp RecentChangesRequest + | SearchProp SearchRequest + | SiteInfoProp SiteInfoRequest + | UserContribsProp UserContribsRequest + | UserInfoProp UserInfoRequest + | WatchListProp WatchListRequest + | BlocksProp BlocksRequest + | DeletedRevsProp DeletedRevisionsRequest + | UsersProp UsersRequest + | RandomProp RandomPagesRequest + +qKind :: QueryRequestKind -> QueryKind +qKind q = + case q of + InfoProp k -> queryKind k + RevisionsProp k -> queryKind k + LinksPropProp k -> queryKind k + LangLinksProp k -> queryKind k + ImagesProp k -> queryKind k + ImageInfoProp k -> queryKind k + TemplatesProp k -> queryKind k + CategoriesProp k -> queryKind k + AllCategoriesProp k -> queryKind k + AllImagesProp k -> queryKind k + AllLinksProp k -> queryKind k + AllMessagesProp k -> queryKind k + AllPagesProp k -> queryKind k + AllUsersProp k -> queryKind k + BacklinksProp k -> queryKind k + EmbeddedInProp k -> queryKind k + ImageUsageProp k -> queryKind k + CategoryInfoProp k -> queryKind k + CategoryMembersProp k -> queryKind k + ExternalLinksProp k -> queryKind k + ExternalURLUsageProp k -> queryKind k + LogEventsProp k -> queryKind k + RecentChangesProp k -> queryKind k + SearchProp k -> queryKind k + SiteInfoProp k -> queryKind k + UserContribsProp k -> queryKind k + UserInfoProp k -> queryKind k + WatchListProp k -> queryKind k + BlocksProp k -> queryKind k + DeletedRevsProp k -> queryKind k + UsersProp k -> queryKind k + RandomProp k -> queryKind k + diff --git a/MediaWiki/API/Output.hs b/MediaWiki/API/Output.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Output.hs @@ -0,0 +1,209 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Output +-- Description : Serializing MediaWiki API types +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Serializing MediaWiki API types +-- +-------------------------------------------------------------------- +module MediaWiki.API.Output where + +import MediaWiki.API.Types +import MediaWiki.API.Base + +import Data.List +import Data.Maybe + + +showRequest :: Request + -> String +showRequest req = + join (showAction (reqAction req) : showMaxLag (reqMaxLag req) (showFormat (reqFormat req))) + +showMaxLag :: Maybe Int -> String -> [String] +showMaxLag Nothing rs = [rs] +showMaxLag (Just l) rs = [field "maxlag" (show l), rs] + +showFormat :: Format -> String +showFormat f = field "format" $ isFormatted (formatFormatted f) $ + case formatKind f of + FormatJSON -> "json" + FormatPHP -> "php" + FormatWDDX -> "wddx" + FormatXML -> "xml" + FormatYAML -> "yaml" + FormatTxt -> "txt" + FormatDbg -> "dbg" + where + isFormatted False xs = xs + isFormatted _ xs = xs++"fm" + +toReq :: APIRequest a => a -> [String] +toReq x = + case catMaybes $ showReq x of + [] -> [] + xs -> map showP xs + where + showP (a,b) = a ++ '=':b + +showQueryRequestKind :: QueryRequestKind -> [String] +showQueryRequestKind r = + case r of + InfoProp p -> toReq p + RevisionsProp p -> toReq p + LinksPropProp p -> toReq p + LangLinksProp p -> toReq p + ImagesProp p -> toReq p + ImageInfoProp p -> toReq p + TemplatesProp p -> toReq p + CategoriesProp p -> toReq p + AllCategoriesProp p -> toReq p + AllImagesProp p -> toReq p + AllLinksProp p -> toReq p + AllMessagesProp p -> toReq p + AllPagesProp p -> toReq p + AllUsersProp p -> toReq p + BacklinksProp p -> toReq p + EmbeddedInProp p -> toReq p + ImageUsageProp p -> toReq p + CategoryInfoProp p -> toReq p + CategoryMembersProp p -> toReq p + ExternalLinksProp p -> toReq p + ExternalURLUsageProp p -> toReq p + LogEventsProp p -> toReq p + RecentChangesProp p -> toReq p + SearchProp p -> toReq p + SiteInfoProp p -> toReq p + UserContribsProp p -> toReq p + UserInfoProp p -> toReq p + WatchListProp p -> toReq p + BlocksProp p -> toReq p + DeletedRevsProp p -> toReq p + UsersProp p -> toReq p + RandomProp p -> toReq p + + +showAction :: Action -> String +showAction act = join $ + case act of + Sitematrix -> [field "action" "sitematrix"] + Login l -> (field "action" "login"): (toReq l) + Logout -> [field "action" "logout"] + Query q qr -> (field "action" "query") : (showQuery q) ++ qr + ExpandTemplates et -> (field "action" "expandtemplates") : (showExpandTemplates et) + Parse pt -> (field "action" "parse") : (showParseRequest pt) + OpenSearch os -> (field "action" "opensearch") : (showOpenSearch os) + FeedWatch f -> (field "action" "feedwatchlist") : (showFeedWatch f) + Help h -> (field "action" "help") : (showHelpRequest h) + ParamInfo pin -> (field "action" "paraminfo") : (showParamInfoRequest pin) + Unblock r -> (field "action" "unblock") : toReq r + Watch r -> (field "action" "watch") : toReq r + EmailUser r -> (field "action" "emailuser") : toReq r + Edit r -> (field "action" "edit") : toReq r + Move r -> (field "action" "move") : toReq r + Block r -> (field "action" "block") : toReq r + Protect r -> (field "action" "protect") : toReq r + Undelete r -> (field "action" "undelete") : toReq r + Delete r -> (field "action" "delete") : toReq r + Rollback r -> (field "action" "rollback") : toReq r + OtherAction at vs -> (field "action" at) : (map showValueName vs) + +{- +showLoginRequest :: LoginRequest -> [String] +showLoginRequest l = catMaybes + [ Just $ field "name" (lgName l) + , Just $ field "password" (lgPassword l) + , fieldMb "version" id (lgDomain l) + ] +-} + +showHelpRequest :: HelpRequest -> [String] +showHelpRequest h = + maybeToList (fieldMb "version" showBool (helpVersion h)) + +showQuery :: QueryRequest -> [String] +showQuery q = catMaybes + [ fieldList "titles" "," (quTitles q) + , fieldList "pageids" "," (quPageIds q) + , fieldList "revids" "," (quRevIds q) + , fieldList "prop" "|" (map showPropKind $ quProps q) + , fieldList "list" "|" (map showListKind $ quLists q) + , fieldList "meta" "|" (map showMetaKind $ quMetas q) + , fieldMb "generator" showGeneratorKind (quGenerator q) + , fieldMb "redirects" showBool (quFollowRedirects q) + , fieldMb "indexpageids" showBool (quIndexPageIds q) + ] + +showExpandTemplates :: ExpandTemplatesRequest -> [String] +showExpandTemplates et = catMaybes + [ fieldMb "title" id (etTitle et) + , Just $ field "text" (etText et) + ] + +showPropKind :: PropKind -> String +showPropKind pk = prKind pk + +showListKind :: ListKind -> String +showListKind lk = liKind lk + +showMetaKind :: MetaKind -> String +showMetaKind mk = meKind mk + +showParseRequest :: ParseRequest -> [String] +showParseRequest p = catMaybes + [ fieldMb "title" id (paTitle p) + , Just $ field "text" (paText p) + , fieldMb "page" id (paPage p) + , fieldList "prop" "|" (paProp p) + ] + +showOpenSearch :: OpenSearchRequest -> [String] +showOpenSearch o = catMaybes + [ Just $ field "search" (osSearch o) + , fieldMb "limit" show (osLimit o) + ] + +showFeedWatch :: FeedWatchListRequest -> [String] +showFeedWatch f = catMaybes + [ Just $ field "feedformat" (if feAsAtom f then "atom" else "rss") + , fieldMb "hours" show (feHours f) + , if feAllRev f then (Just $ field "allrev" "") else Nothing + ] + +showParamInfoRequest :: ParamInfoRequest -> [String] +showParamInfoRequest p = catMaybes + [ fieldList "modules" "," (paModules p) + , fieldList "querymodules" "|" (paQueryModules p) + ] + +showGeneratorKind :: GeneratorKind -> String +showGeneratorKind gk = genKind gk + +showValueName :: ValueName -> String +showValueName (n,v) = field n v + +showBool :: Bool -> String +showBool True = "true" +showBool _ = "false" + +join :: [String] -> String +join [] = "" +join xs = concat (intersperse "&" xs) + +field :: String -> String -> String +field a b = a ++ '=':b + +fieldMb :: String -> (a -> String) -> Maybe a -> Maybe String +fieldMb _ _ Nothing = Nothing +fieldMb n f (Just x) = Just (field n (f x)) + +fieldList :: String -> String -> [String] -> Maybe String +fieldList _ _ [] = Nothing +fieldList n s xs = Just (field n (concat $ intersperse s xs)) + diff --git a/MediaWiki/API/Query/AllCategories.hs b/MediaWiki/API/Query/AllCategories.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllCategories.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllCategories +-- Description : Representing 'allcategories' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'allcategories' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllCategories where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.CategoryInfo ( CategoryInfo ) + +data AllCategoriesRequest + = AllCategoriesRequest + { acFrom :: Maybe PageName + , acPrefix :: Maybe PageName + , acDir :: Maybe Direction + , acLimit :: Maybe Int + , acProp :: [String] + } + +instance APIRequest AllCategoriesRequest where + queryKind _ = QList "allcategories" + showReq r + = [ mbOpt "acfrom" id (acFrom r) + , mbOpt "acprefix" id (acPrefix r) + , mbOpt "acdir" (\ x -> if x == Up then "ascending" else "descending") + (acDir r) + , mbOpt "aclimit" show (acLimit r) + , opt1 "acprop" (acProp r) + ] + +emptyAllCategoriesRequest :: AllCategoriesRequest +emptyAllCategoriesRequest = AllCategoriesRequest + { acFrom = Nothing + , acPrefix = Nothing + , acDir = Nothing + , acLimit = Nothing + , acProp = [] + } + + +data AllCategoriesResponse + = AllCategoriesResponse + { acCategories :: [CategoryInfo] + , acContinue :: Maybe String + } + +emptyAllCategoriesResponse :: AllCategoriesResponse +emptyAllCategoriesResponse + = AllCategoriesResponse + { acCategories = [] + , acContinue = Nothing + } diff --git a/MediaWiki/API/Query/AllCategories/Import.hs b/MediaWiki/API/Query/AllCategories/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllCategories/Import.hs @@ -0,0 +1,33 @@ +module MediaWiki.API.Query.AllCategories.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllCategories +import MediaWiki.API.Query.CategoryInfo +import MediaWiki.API.Query.CategoryInfo.Import ( xmlCI ) + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllCategoriesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllCategoriesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlCII) (fmap children $ pNode "allcategories" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "allcategories" "acfrom" + return emptyAllCategoriesResponse{acCategories=ps,acContinue=cont} + +xmlCII :: Element -> Maybe CategoryInfo +xmlCII e = do + c <- xmlCI emptyPageTitle "c" e + let tit = strContent e + return c{ciPage=(ciPage c){pgTitle=tit}} + diff --git a/MediaWiki/API/Query/AllImages.hs b/MediaWiki/API/Query/AllImages.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllImages.hs @@ -0,0 +1,75 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllImages +-- Description : Representing 'allimages' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'allimages' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllImages where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.ImageInfo ( ImageInfo ) + +data AllImagesRequest + = AllImagesRequest + { aiFrom :: Maybe PageName + , aiPrefix :: Maybe PageName + , aiMinSize :: Maybe Int + , aiMaxSize :: Maybe Int + , aiLimit :: Maybe Int + , aiDir :: Maybe Direction + , aiSha1 :: Maybe String + , aiSha1Base36 :: Maybe String + , aiProp :: [String] + } + +instance APIRequest AllImagesRequest where + queryKind _ = QList "allimages" + showReq r + = [ mbOpt "aifrom" id (aiFrom r) + , mbOpt "aiprefix" id (aiPrefix r) + , mbOpt "aiminsize" show (aiMinSize r) + , mbOpt "aimaxsize" show (aiMaxSize r) + , mbOpt "ailimit" show (aiLimit r) + , mbOpt "aidir" (\ x -> if x == Up then "ascending" else "descending") + (aiDir r) + , mbOpt "aisha1" id (aiSha1 r) + , mbOpt "aisha1base36" id (aiSha1Base36 r) + , opt1 "aiprop" (aiProp r) + ] + + +emptyAllImagesRequest :: AllImagesRequest +emptyAllImagesRequest = AllImagesRequest + { aiFrom = Nothing + , aiPrefix = Nothing + , aiMinSize = Nothing + , aiMaxSize = Nothing + , aiLimit = Nothing + , aiDir = Nothing + , aiSha1 = Nothing + , aiSha1Base36 = Nothing + , aiProp = [] + } + + +data AllImagesResponse + = AllImagesResponse + { aiImages :: [ImageInfo] + , aiContinue :: Maybe String + } + +emptyAllImagesResponse :: AllImagesResponse +emptyAllImagesResponse + = AllImagesResponse + { aiImages = [] + , aiContinue = Nothing + } diff --git a/MediaWiki/API/Query/AllImages/Import.hs b/MediaWiki/API/Query/AllImages/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllImages/Import.hs @@ -0,0 +1,25 @@ +module MediaWiki.API.Query.AllImages.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllImages +import MediaWiki.API.Query.ImageInfo.Import ( xmlII ) + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllImagesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllImagesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe (xmlII "img")) (fmap children $ pNode "allimages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "allimages" "aifrom" + return emptyAllImagesResponse{aiImages=ps,aiContinue=cont} diff --git a/MediaWiki/API/Query/AllLinks.hs b/MediaWiki/API/Query/AllLinks.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllLinks.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllLinks +-- Description : Representing 'alllinks' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'alllinks' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllLinks where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data AllLinksRequest + = AllLinksRequest + { alContinueFrom :: Maybe String + , alFrom :: Maybe PageName + , alPrefix :: Maybe PageName + , alUnique :: Bool + , alProp :: [String] + , alNamespace :: Maybe NamespaceID + , alLimit :: Maybe Int + } + +instance APIRequest AllLinksRequest where + queryKind _ = QList "alllinks" + showReq r = + [ mbOpt "alcontinue" id (alContinueFrom r) + , mbOpt "alfrom" id (alFrom r) + , mbOpt "alprefix" id (alPrefix r) + , optB "alunique" (alUnique r) + , opt1 "alprop" (alProp r) + , mbOpt "alnamespace" id (alNamespace r) + , mbOpt "allimit" show (alLimit r) + ] + +emptyAllLinksRequest :: AllLinksRequest +emptyAllLinksRequest = AllLinksRequest + { alContinueFrom = Nothing + , alFrom = Nothing + , alPrefix = Nothing + , alUnique = False + , alProp = [] + , alNamespace = Nothing + , alLimit = Nothing + } + +data AllLinksResponse + = AllLinksResponse + { alLinks :: [PageTitle] + , alContinue :: Maybe String + } + +emptyAllLinksResponse :: AllLinksResponse +emptyAllLinksResponse + = AllLinksResponse + { alLinks = [] + , alContinue = Nothing + } + diff --git a/MediaWiki/API/Query/AllLinks/Import.hs b/MediaWiki/API/Query/AllLinks/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllLinks/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.AllLinks.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllLinks + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllLinksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllLinksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlLink) (fmap children $ pNode "alllinks" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "alllinks" "alcontinue" + return emptyAllLinksResponse{alLinks=ps,alContinue=cont} + +xmlLink :: Element -> Maybe PageTitle +xmlLink e = do + guard (elName e == nsName "l") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "fromid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/AllMessages.hs b/MediaWiki/API/Query/AllMessages.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllMessages.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllMessages +-- Description : Representing 'allmessages' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'allmessages' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllMessages where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data AllMessagesRequest + = AllMessagesRequest + { amMessages :: [String] + , amFilter :: Maybe String + , amLang :: Maybe String + } + +instance APIRequest AllMessagesRequest where + queryKind _ = QMeta "allmessages" + showReq r = [ opt1 "ammessages" (amMessages r) + , mbOpt "amfilter" id (amFilter r) + , mbOpt "amlang" id (amLang r) + ] + +emptyAllMessagesRequest :: AllMessagesRequest +emptyAllMessagesRequest = AllMessagesRequest + { amMessages = [] + , amFilter = Nothing + , amLang = Nothing + } + + +data AllMessagesResponse + = AllMessagesResponse + { amsgMessages :: [MessageInfo] + } + +emptyAllMessagesResponse :: AllMessagesResponse +emptyAllMessagesResponse + = AllMessagesResponse + { amsgMessages = [] + } + +data MessageInfo + = MessageInfo + { msgiName :: String + , msgiMissing :: Bool + , msgiContent :: String + } + +emptyMessageInfo :: MessageInfo +emptyMessageInfo = MessageInfo + { msgiName = "" + , msgiMissing = False + , msgiContent = "" + } + diff --git a/MediaWiki/API/Query/AllMessages/Import.hs b/MediaWiki/API/Query/AllMessages/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllMessages/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.AllMessages.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllMessages + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllMessagesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllMessagesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + return emptyAllMessagesResponse{amsgMessages=ps} + +xmlPage :: Element -> Maybe MessageInfo +xmlPage e = do + guard (elName e == nsName "message") + let nm = fromMaybe "" $ pAttr "name" e + let mi = isJust (pAttr "missing" e) + return emptyMessageInfo{msgiName=nm,msgiMissing=mi,msgiContent=strContent e} + diff --git a/MediaWiki/API/Query/AllPages.hs b/MediaWiki/API/Query/AllPages.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllPages.hs @@ -0,0 +1,76 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllPages +-- Description : Representing 'allpages' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'allpages' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllPages where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data AllPagesRequest + = AllPagesRequest + { apFrom :: Maybe PageName + , apPrefix :: Maybe PageName + , apNamespace :: NamespaceID + , apFilterRedir :: Maybe WithRedirects + , apMinSize :: Maybe Int + , apMaxSize :: Maybe Int + , apProtTypeLevel :: ([String],[String]) + , apLimit :: Maybe Int + , apDir :: Maybe Direction + , apFilterLangLinks :: Maybe FilterLang + } + +instance APIRequest AllPagesRequest where + queryKind _ = QList "allpages" + showReq r = + [ mbOpt "apfrom" id (apFrom r) + , mbOpt "apprefix" id (apPrefix r) + , mbOpt "apnamespace" id (Just $ apNamespace r) + , mbOpt "apfilterredir" id (apFilterRedir r) + , mbOpt "apminsize" show (apMinSize r) + , mbOpt "apmaxsize" show (apMaxSize r) + , mbOpt "apprtype" (piped.fst) (Just $ apProtTypeLevel r) + , mbOpt "apprlevel" (piped.snd) (Just $ apProtTypeLevel r) + , mbOpt "aplimit" show (apLimit r) + , mbOpt "apdir" (\ x -> if x==Up then "ascending" else "descending") (apDir r) + , mbOpt "apfilterlanglinks" id (apFilterLangLinks r) + ] + +emptyAllPagesRequest :: AllPagesRequest +emptyAllPagesRequest = AllPagesRequest + { apFrom = Nothing + , apPrefix = Nothing + , apNamespace = mainNamespace + , apFilterRedir = Nothing + , apMinSize = Nothing + , apMaxSize = Nothing + , apProtTypeLevel = ([],[]) + , apLimit = Nothing + , apDir = Nothing + , apFilterLangLinks = Nothing + } + + +data AllPagesResponse + = AllPagesResponse + { apLinks :: [PageTitle] -- seems to have evolved now (1.13) to PageInfo. + , apContinue :: Maybe String + } + +emptyAllPagesResponse :: AllPagesResponse +emptyAllPagesResponse + = AllPagesResponse + { apLinks = [] + , apContinue = Nothing + } diff --git a/MediaWiki/API/Query/AllPages/Import.hs b/MediaWiki/API/Query/AllPages/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllPages/Import.hs @@ -0,0 +1,37 @@ +module MediaWiki.API.Query.AllPages.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllPages + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllPagesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllPagesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "allpages" "gapfrom" + return emptyAllPagesResponse{apLinks=ps,apContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + -- more to follow, I'm also seeing these with 1.13: + let tou = pAttr "touched" e + let las = pAttr "lastrevid" e + let views = pAttr "counter" e + let len = pAttr "length" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/AllUsers.hs b/MediaWiki/API/Query/AllUsers.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllUsers.hs @@ -0,0 +1,60 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.AllUsers +-- Description : Representing 'allusers' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'allusers' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.AllUsers where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data AllUsersRequest + = AllUsersRequest + { auFrom :: Maybe UserName + , auPrefix :: Maybe UserName + , auGroup :: Maybe GroupName + , auProp :: [String] + , auLimit :: Maybe Int + } + +instance APIRequest AllUsersRequest where + queryKind _ = QList "allusers" + showReq r = + [ mbOpt "aufrom" id (auFrom r) + , mbOpt "auprefix" id (auPrefix r) + , mbOpt "augroup" id (auGroup r) + , opt1 "auprop" (auProp r) + , mbOpt "aulimit" show (auLimit r) + ] + + +emptyAllUsersRequest :: AllUsersRequest +emptyAllUsersRequest = AllUsersRequest + { auFrom = Nothing + , auPrefix = Nothing + , auGroup = Nothing + , auProp = [] + , auLimit = Nothing + } + +data AllUsersResponse + = AllUsersResponse + { auUsers :: [(UserName, Maybe Int, Maybe String)] + , auContinue :: Maybe String + } + +emptyAllUsersResponse :: AllUsersResponse +emptyAllUsersResponse + = AllUsersResponse + { auUsers = [] + , auContinue = Nothing + } diff --git a/MediaWiki/API/Query/AllUsers/Import.hs b/MediaWiki/API/Query/AllUsers/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/AllUsers/Import.hs @@ -0,0 +1,33 @@ +module MediaWiki.API.Query.AllUsers.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.AllUsers + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) AllUsersResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe AllUsersResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlUser) (fmap children $ pNode "allusers" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "allusers" "aufrom" + return emptyAllUsersResponse{auUsers=ps,auContinue=cont} + +xmlUser :: Element -> Maybe (UserName,Maybe Int, Maybe String) +xmlUser e = do + guard (elName e == nsName "u") + let ns = fromMaybe "0" $ pAttr "ns" e + let nm = fromMaybe "" $ pAttr "name" e + let ec = pAttr "editcount" e >>= \ x -> case reads x of { ((v,_):_) -> Just v; _ -> Nothing} + let grps = pAttr "groups" e + return (nm,ec,grps) diff --git a/MediaWiki/API/Query/BackLinks.hs b/MediaWiki/API/Query/BackLinks.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/BackLinks.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.BackLinks +-- Description : Representing 'backlinks' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'backlinks' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.BackLinks where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data BackLinksRequest + = BackLinksRequest + { blTitle :: Maybe String + , blContinueFrom :: Maybe String + , blNamespace :: [NamespaceID] + , blFilterRedir :: Maybe Redirect + , blRedirect :: Maybe Bool + , blLimit :: Maybe Int + } + +instance APIRequest BackLinksRequest where + queryKind _ = QList "backlinks" + showReq r = + [ mbOpt "bltitle" id (blTitle r) + , mbOpt "blcontinue" id (blContinueFrom r) + , opt1 "blnamespace" (blNamespace r) + , mbOpt "blfilterredir" id (blFilterRedir r) + , optB "blredirect" (fromMaybe False $ blRedirect r) + , mbOpt "bllimit" show (blLimit r) + ] + +emptyBackLinksRequest :: BackLinksRequest +emptyBackLinksRequest = BackLinksRequest + { blTitle = Nothing + , blContinueFrom = Nothing + , blNamespace = [] + , blFilterRedir = Nothing + , blRedirect = Nothing + , blLimit = Nothing + } + +data BackLinksResponse + = BackLinksResponse + { blLinks :: [PageTitle] + , blContinue :: Maybe String + } + +emptyBackLinksResponse :: BackLinksResponse +emptyBackLinksResponse + = BackLinksResponse + { blLinks = [] + , blContinue = Nothing + } diff --git a/MediaWiki/API/Query/BackLinks/Import.hs b/MediaWiki/API/Query/BackLinks/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/BackLinks/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.BackLinks.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.BackLinks + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) BackLinksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe BackLinksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "backlinks" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "backlinks" "blcontinue" + return emptyBackLinksResponse{blLinks=ps,blContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "bl") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid} diff --git a/MediaWiki/API/Query/Blocks.hs b/MediaWiki/API/Query/Blocks.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Blocks.hs @@ -0,0 +1,107 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Blocks +-- Description : Representing 'blocks' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'blocks' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Blocks where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data BlocksRequest + = BlocksRequest + { bkStart :: Maybe Timestamp + , bkEnd :: Maybe Timestamp + , bkDir :: Maybe TimeArrow + , bkIds :: [UserID] + , bkUsers :: [UserID] + , bkIp :: [String] + , bkLimit :: Maybe Int + , bkProp :: [String] + } + +instance APIRequest BlocksRequest where + queryKind _ = QList "blocks" + showReq r + = [ mbOpt "bkstart" id (bkStart r) + , mbOpt "bkend" id (bkEnd r) + , mbOpt "bkdir" (\ x -> if x==Earlier then "older" else "newer") + (bkDir r) + , opt1 "bkids" (bkIds r) + , opt1 "bkusers" (bkUsers r) + , opt1 "bkip" (bkIp r) + , mbOpt "bklimit" show (bkLimit r) + , opt1 "bkprop" (bkProp r) + ] + +emptyBlocksRequest :: BlocksRequest +emptyBlocksRequest = BlocksRequest + { bkStart = Nothing + , bkEnd = Nothing + , bkDir = Nothing + , bkIds = [] + , bkUsers = [] + , bkIp = [] + , bkLimit = Nothing + , bkProp = [] + } + +data BlocksResponse + = BlocksResponse + { bkBlocks :: [BlockInfo] + , bkContinue :: Maybe String + } + +emptyBlocksResponse :: BlocksResponse +emptyBlocksResponse = BlocksResponse + { bkBlocks = [] + , bkContinue = Nothing + } + +data BlockInfo + = BlockInfo + { bkId :: Maybe String + , bkUser :: Maybe UserName + , bkBy :: Maybe UserName + , bkTimestamp :: Maybe Timestamp + , bkExpiry :: Maybe Timestamp + , bkReason :: Maybe String + , bkRangeStart :: Maybe String + , bkRangeEnd :: Maybe String + , bkIsAuto :: Bool + , bkIsAnonOnly :: Bool + , bkIsNoCreate :: Bool + , bkIsAutoBlock :: Bool + , bkIsNoEmail :: Bool + , bkIsHidden :: Bool + } + +emptyBlockInfo :: BlockInfo +emptyBlockInfo = BlockInfo + { bkId = Nothing + , bkUser = Nothing + , bkBy = Nothing + , bkTimestamp = Nothing + , bkExpiry = Nothing + , bkReason = Nothing + , bkRangeStart = Nothing + , bkRangeEnd = Nothing + , bkIsAuto = False + , bkIsAnonOnly = False + , bkIsNoCreate = False + , bkIsAutoBlock = False + , bkIsNoEmail = False + , bkIsHidden = False + } + + + diff --git a/MediaWiki/API/Query/Blocks/Import.hs b/MediaWiki/API/Query/Blocks/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Blocks/Import.hs @@ -0,0 +1,58 @@ +module MediaWiki.API.Query.Blocks.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Blocks + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) BlocksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe BlocksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlB) (fmap children $ pNode "blocks" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "blocks" "blfrom" + return emptyBlocksResponse{bkBlocks=ps,bkContinue=cont} + +xmlB :: Element -> Maybe BlockInfo +xmlB e = do + guard (elName e == nsName "block") + let i = pAttr "id" e + let usr = pAttr "user" e + let by = pAttr "by" e + let ts = pAttr "timestamp" e + let ex = pAttr "expiry" e + let re = pAttr "reason" e + let ras = pAttr "rangestart" e + let rae = pAttr "rangeend" e + let isa = isJust $ pAttr "automatic" e + let isan = isJust $ pAttr "anononly" e + let isnc = isJust $ pAttr "nocreate" e + let isab = isJust $ pAttr "autoblock" e + let isne = isJust $ pAttr "noemail" e + let ishi = isJust $ pAttr "hidden" e + return emptyBlockInfo + { bkId = i + , bkUser = usr + , bkBy = by + , bkTimestamp = ts + , bkExpiry = ex + , bkReason = re + , bkRangeStart = ras + , bkRangeEnd = rae + , bkIsAuto = isa + , bkIsAnonOnly = isan + , bkIsNoCreate = isnc + , bkIsAutoBlock = isab + , bkIsNoEmail = isne + , bkIsHidden = ishi + } diff --git a/MediaWiki/API/Query/Categories.hs b/MediaWiki/API/Query/Categories.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Categories.hs @@ -0,0 +1,57 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Categories +-- Description : Representing 'categories' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'categories' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Categories where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data CategoriesRequest + = CategoriesRequest + { clProps :: [PropKind] + , clShow :: Maybe Bool + , clLimit :: Maybe Int + , clContinueFrom :: Maybe String + } + +instance APIRequest CategoriesRequest where + queryKind _ = QProp "categories" + showReq r = + [ opt1 "clprop" (map prKind $ clProps r) + , mbOpt "clshow" (\ x -> if x then "!hidden" else "hidden") (clShow r) + , mbOpt "cllimit" show (clLimit r) + , mbOpt "clcontinue" id (clContinueFrom r) + ] + +emptyCategoriesRequest :: CategoriesRequest +emptyCategoriesRequest = CategoriesRequest + { clProps = [] + , clShow = Nothing + , clLimit = Nothing + , clContinueFrom = Nothing + } + + +data CategoriesResponse + = CategoriesResponse + { clPages :: [(PageTitle,[PageTitle])] + , clContinue :: Maybe String + } + +emptyCategoriesResponse :: CategoriesResponse +emptyCategoriesResponse + = CategoriesResponse + { clPages = [] + , clContinue = Nothing + } diff --git a/MediaWiki/API/Query/Categories/Import.hs b/MediaWiki/API/Query/Categories/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Categories/Import.hs @@ -0,0 +1,45 @@ +module MediaWiki.API.Query.Categories.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Categories + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) CategoriesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe CategoriesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es2 = children p + p <- pNode "pages" es2 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "page" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "categories" "clcontinue" + return emptyCategoriesResponse{clPages=ps,clContinue=cont} + +xmlPage :: Element -> Maybe (PageTitle,[PageTitle]) +xmlPage e = do + guard (elName e == nsName "page") + let es = children e + p <- pNode "categories" es + let es1 = children p + cs <- fmap (mapMaybe xmlCL) (fmap children $ pNode "cl" es1) + let ns = fromMaybe "0" $ pAttr "ns" p + let tit = fromMaybe "" $ pAttr "title" p + let mbpid = pAttr "pageid" p + return (emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid}, cs) + +xmlCL :: Element -> Maybe PageTitle +xmlCL e = do + guard (elName e == nsName "cl") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid} diff --git a/MediaWiki/API/Query/CategoryInfo.hs b/MediaWiki/API/Query/CategoryInfo.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/CategoryInfo.hs @@ -0,0 +1,59 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.CategoryInfo +-- Description : Representing CategoryInfo requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing CategoryInfo requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.CategoryInfo where + +import MediaWiki.API.Types +import MediaWiki.API.Utils () + +data CategoryInfoRequest + = CategoryInfoRequest + +instance APIRequest CategoryInfoRequest where + queryKind _ = QProp "categoryinfo" + showReq _ = [] + +emptyCategoryInfoRequest :: CategoryInfoRequest +emptyCategoryInfoRequest = CategoryInfoRequest + +data CategoryInfoResponse + = CategoryInfoResponse + { ciPages :: [CategoryInfo] + } + +emptyCategoryInfoResponse :: CategoryInfoResponse +emptyCategoryInfoResponse = CategoryInfoResponse + { ciPages = [] + } + +data CategoryInfo + = CategoryInfo + { ciPage :: PageTitle + , ciSize :: Maybe Int + , ciPageSize :: Maybe Int + , ciFiles :: Maybe Int + , ciSubCats :: Maybe Int + , ciHidden :: Bool + } + +emptyCategoryInfo :: CategoryInfo +emptyCategoryInfo = CategoryInfo + { ciPage = emptyPageTitle + , ciSize = Nothing + , ciPageSize = Nothing + , ciFiles = Nothing + , ciSubCats = Nothing + , ciHidden = False + } + diff --git a/MediaWiki/API/Query/CategoryInfo/Import.hs b/MediaWiki/API/Query/CategoryInfo/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/CategoryInfo/Import.hs @@ -0,0 +1,50 @@ +module MediaWiki.API.Query.CategoryInfo.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.CategoryInfo + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) CategoryInfoResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe CategoryInfoResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + return emptyCategoryInfoResponse{ciPages=ps} + +xmlPage :: Element -> Maybe CategoryInfo +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let pg = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} + let cs = mapMaybe (xmlCI pg "categoryinfo") (children e) + listToMaybe cs + +xmlCI :: PageTitle -> String -> Element -> Maybe CategoryInfo +xmlCI pg tg e = do + guard (elName e == nsName tg) + let sz = pAttr "size" e >>= readMb + let psz = pAttr "pagesize" e >>= readMb + let fi = pAttr "files" e >>= readMb + let su = pAttr "subcats" e >>= readMb + let hi = isJust (pAttr "hidden" e) + return emptyCategoryInfo + { ciPage = pg + , ciSize = sz + , ciPageSize = psz + , ciFiles = fi + , ciSubCats = su + , ciHidden = hi + } + diff --git a/MediaWiki/API/Query/CategoryMembers.hs b/MediaWiki/API/Query/CategoryMembers.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/CategoryMembers.hs @@ -0,0 +1,71 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.CategoryMembers +-- Description : Representing 'categorymembers' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'categorymembers' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.CategoryMembers where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data CategoryMembersRequest + = CategoryMembersRequest + { cmTitle :: Maybe PageName + , cmProp :: [String] + , cmNamespace :: [NamespaceID] + , cmContinueFrom :: Maybe String + , cmLimit :: Maybe Int + , cmSort :: Maybe SortKind + , cmDir :: Maybe Direction + , cmStart :: Maybe Timestamp + , cmEnd :: Maybe Timestamp + } + +instance APIRequest CategoryMembersRequest where + queryKind _ = QList "categorymembers" + showReq r = + [ mbOpt "cmtitle" id (cmTitle r) + , opt1 "cmprop" (cmProp r) + , opt1 "cmnamespace" (cmNamespace r) + , mbOpt "cmcontinue" id (cmContinueFrom r) + , mbOpt "cmlimit" show (cmLimit r) + , mbOpt "cmsort" id (cmSort r) + , mbOpt "cmdir" (\ x -> if x==Up then "asc" else "desc") (cmDir r) + , mbOpt "cmstart" id (cmStart r) + , mbOpt "cmend" id (cmEnd r) + ] + +emptyCategoryMembersRequest :: CategoryMembersRequest +emptyCategoryMembersRequest = CategoryMembersRequest + { cmTitle = Nothing + , cmProp = [] + , cmNamespace = [] + , cmContinueFrom = Nothing + , cmLimit = Nothing + , cmSort = Nothing + , cmDir = Nothing + , cmStart = Nothing + , cmEnd = Nothing + } + +data CategoryMembersResponse + = CategoryMembersResponse + { cmPages :: [PageTitle] + , cmContinue :: Maybe String + } + +emptyCategoryMembersResponse :: CategoryMembersResponse +emptyCategoryMembersResponse = CategoryMembersResponse + { cmPages = [] + , cmContinue = Nothing + } + diff --git a/MediaWiki/API/Query/CategoryMembers/Import.hs b/MediaWiki/API/Query/CategoryMembers/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/CategoryMembers/Import.hs @@ -0,0 +1,32 @@ +module MediaWiki.API.Query.CategoryMembers.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.CategoryMembers + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) CategoryMembersResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe CategoryMembersResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "categorymembers" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "categorymembers" "cmcontinue" + return emptyCategoryMembersResponse{cmPages=ps,cmContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "cm") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + let ts = pAttr "timestamp" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid} diff --git a/MediaWiki/API/Query/DeletedRevisions.hs b/MediaWiki/API/Query/DeletedRevisions.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/DeletedRevisions.hs @@ -0,0 +1,85 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.DeletedRevisions +-- Description : Representing 'deletedrevs' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'deletedrevs' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.DeletedRevisions where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data DeletedRevisionsRequest + = DeletedRevisionsRequest + { drStart :: Maybe Timestamp + , drEnd :: Maybe Timestamp + , drDir :: Maybe TimeArrow + , drLimit :: Maybe Int + , drProp :: [String] + } + +instance APIRequest DeletedRevisionsRequest where + queryKind _ = QList "deletedrevs" + showReq r = [ mbOpt "drstart" id (drStart r) + , mbOpt "drend" id (drEnd r) + , mbOpt "drdir" (\ x -> if x==Earlier then "older" else "newer") + (drDir r) + , mbOpt "drlimit" show (drLimit r) + , opt1 "drprop" (drProp r) + ] + +emptyDeletedRevisionsRequest :: DeletedRevisionsRequest +emptyDeletedRevisionsRequest = DeletedRevisionsRequest + { drStart = Nothing + , drEnd = Nothing + , drDir = Nothing + , drLimit = Nothing + , drProp = [] + } + +data DeletedRevisionsResponse + = DeletedRevisionsResponse + { drRevisions :: [DeletedRevision] + , drContinue :: Maybe String + } + +emptyDeletedRevisionsResponse :: DeletedRevisionsResponse +emptyDeletedRevisionsResponse = DeletedRevisionsResponse + { drRevisions = [] + , drContinue = Nothing + } + +data DeletedRevision + = DeletedRevision + { drPage :: PageTitle + , drTimestamp :: Maybe Timestamp + , drRevId :: Maybe RevID + , drUser :: Maybe UserName + , drComment :: Maybe String + , drIsMinor :: Bool + , drLength :: Maybe Int + , drContent :: Maybe String + , drToken :: Maybe String + } + +emptyDeletedRevision :: DeletedRevision +emptyDeletedRevision + = DeletedRevision + { drPage = emptyPageTitle + , drTimestamp = Nothing + , drRevId = Nothing + , drUser = Nothing + , drComment = Nothing + , drIsMinor = False + , drLength = Nothing + , drContent = Nothing + , drToken = Nothing + } diff --git a/MediaWiki/API/Query/DeletedRevisions/Import.hs b/MediaWiki/API/Query/DeletedRevisions/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/DeletedRevisions/Import.hs @@ -0,0 +1,51 @@ +module MediaWiki.API.Query.DeletedRevisions.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.DeletedRevisions + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) DeletedRevisionsResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe DeletedRevisionsResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "revisions" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "deletedrevs" "drstart" + return emptyDeletedRevisionsResponse{drRevisions=ps,drContinue=cont} + +xmlPage :: Element -> Maybe DeletedRevision +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let pg = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} + let ts = pAttr "timestamp" e + let re = pAttr "revid" e + let usr = pAttr "user" e + let co = pAttr "comment" e + let ism = isJust $ pAttr "minor" e + let le = pAttr "len" e >>= readMb + let cts = case (strContent e) of { "" -> Nothing; xs -> Just xs} + let tok = pAttr "token" e + return emptyDeletedRevision + { drPage = pg + , drTimestamp = ts + , drRevId = re + , drUser = usr + , drComment = co + , drIsMinor = ism + , drLength = le + , drContent = cts + , drToken = tok + } diff --git a/MediaWiki/API/Query/EmbeddedIn.hs b/MediaWiki/API/Query/EmbeddedIn.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/EmbeddedIn.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.EmbeddedIn +-- Description : Representing 'embeddedin' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'embeddedin' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.EmbeddedIn where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data EmbeddedInRequest + = EmbeddedInRequest + { eiTitle :: Maybe String + , eiContinueFrom :: Maybe String + , eiNamespace :: [NamespaceID] + , eiFilterRedir :: Maybe Redirect + , eiRedirect :: Bool + , eiLimit :: Maybe Int + } + +instance APIRequest EmbeddedInRequest where + queryKind _ = QList "embeddedin" + showReq r = + [ mbOpt "eititle" id (eiTitle r) + , mbOpt "eicontinue" id (eiContinueFrom r) + , opt1 "einamespace" (eiNamespace r) + , mbOpt "eifilterredir" id (eiFilterRedir r) + , optB "eirdirect" (eiRedirect r) + , mbOpt "eilimit" show (eiLimit r) + ] + +emptyEmbeddedInRequest :: EmbeddedInRequest +emptyEmbeddedInRequest = EmbeddedInRequest + { eiTitle = Nothing + , eiContinueFrom = Nothing + , eiNamespace = [] + , eiFilterRedir = Nothing + , eiRedirect = False + , eiLimit = Nothing + } + +data EmbeddedInResponse + = EmbeddedInResponse + { eiLinks :: [PageTitle] + , eiContinue :: Maybe String + } + +emptyEmbeddedInResponse :: EmbeddedInResponse +emptyEmbeddedInResponse + = EmbeddedInResponse + { eiLinks = [] + , eiContinue = Nothing + } diff --git a/MediaWiki/API/Query/EmbeddedIn/Import.hs b/MediaWiki/API/Query/EmbeddedIn/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/EmbeddedIn/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.EmbeddedIn.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.EmbeddedIn + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) EmbeddedInResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe EmbeddedInResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "embeddedin" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "embeddedin" "eicontinue" + return emptyEmbeddedInResponse{eiLinks=ps,eiContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "ei") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid} diff --git a/MediaWiki/API/Query/ExternalLinks.hs b/MediaWiki/API/Query/ExternalLinks.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ExternalLinks.hs @@ -0,0 +1,50 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.ExternalLinks +-- Description : Representing 'extlinks' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'extlinks' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.ExternalLinks where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ExternalLinksRequest + = ExternalLinksRequest + { elLimit :: Maybe Int + , elOffset :: Maybe String + } + +instance APIRequest ExternalLinksRequest where + queryKind _ = QProp "extlinks" + showReq r = + [ mbOpt "ellimit" show (elLimit r) + , mbOpt "eloffset" id (elOffset r) + ] + +emptyExternalLinksRequest :: ExternalLinksRequest +emptyExternalLinksRequest = ExternalLinksRequest + { elLimit = Nothing + , elOffset = Nothing + } + +data ExternalLinksResponse + = ExternalLinksResponse + { elPages :: [(PageTitle,[URLString])] + , elContinue :: Maybe String + } + +emptyExternalLinksResponse :: ExternalLinksResponse +emptyExternalLinksResponse = ExternalLinksResponse + { elPages = [] + , elContinue = Nothing + } + diff --git a/MediaWiki/API/Query/ExternalLinks/Import.hs b/MediaWiki/API/Query/ExternalLinks/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ExternalLinks/Import.hs @@ -0,0 +1,44 @@ +module MediaWiki.API.Query.ExternalLinks.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.ExternalLinks + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ExternalLinksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ExternalLinksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es2 = children p + p <- pNode "pages" es2 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "page" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "extlinks" "eloffset" + return emptyExternalLinksResponse{elPages=ps,elContinue=cont} + +xmlPage :: Element -> Maybe (PageTitle,[URLString]) +xmlPage e = do + guard (elName e == nsName "page") + let es = children e + p <- pNode "extlinks" es + let es1 = children p + cs <- fmap (mapMaybe xmlEL) (fmap children $ pNode "el" es1) + let ns = fromMaybe "0" $ pAttr "ns" p + let tit = fromMaybe "" $ pAttr "title" p + let mbpid = pAttr "pageid" p + return (emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid}, cs) + +xmlEL :: Element -> Maybe URLString +xmlEL e = do + guard (elName e == nsName "el") + return (strContent e) + diff --git a/MediaWiki/API/Query/ExternalURLUsage.hs b/MediaWiki/API/Query/ExternalURLUsage.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ExternalURLUsage.hs @@ -0,0 +1,63 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.ExternalURLUsage +-- Description : Representing 'exturlusage' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'exturlusage' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.ExternalURLUsage where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ExternalURLUsageRequest + = ExternalURLUsageRequest + { euProp :: [String] + , euOffset :: Maybe String + , euProtocol :: Maybe String + , euQuery :: Maybe String + , euNamespaces :: [NamespaceID] + , euLimit :: Maybe Int + } + +instance APIRequest ExternalURLUsageRequest where + queryKind _ = QList "exturlusage" + showReq r = + [ opt1 "euprop" (euProp r) + , mbOpt "euoffset" id (euOffset r) + , mbOpt "euprotocol" id (euProtocol r) + , mbOpt "euquery" id (euQuery r) + , opt1 "eunamespace" (euNamespaces r) + , mbOpt "eulimit" show (euLimit r) + ] + +emptyExternalURLUsageRequest :: ExternalURLUsageRequest +emptyExternalURLUsageRequest = ExternalURLUsageRequest + { euProp = [] + , euOffset = Nothing + , euProtocol = Nothing + , euQuery = Nothing + , euNamespaces = [] + , euLimit = Nothing + } + +data ExternalURLUsageResponse + = ExternalURLUsageResponse + { euPages :: [(URLString,PageTitle)] + , euContinue :: Maybe String + } + +emptyExternalURLUsageResponse :: ExternalURLUsageResponse +emptyExternalURLUsageResponse = ExternalURLUsageResponse + { euPages = [] + , euContinue = Nothing + } + + diff --git a/MediaWiki/API/Query/ExternalURLUsage/Import.hs b/MediaWiki/API/Query/ExternalURLUsage/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ExternalURLUsage/Import.hs @@ -0,0 +1,35 @@ +module MediaWiki.API.Query.ExternalURLUsage.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.ExternalURLUsage + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ExternalURLUsageResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ExternalURLUsageResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "exturlusage" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "exturlusage" "euoffset" + return emptyExternalURLUsageResponse{euPages=ps,euContinue=cont} + +xmlPage :: Element -> Maybe (URLString,PageTitle) +xmlPage e = do + guard (elName e == nsName "eu") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + let url = fromMaybe "" $ pAttr "url" e + return (url,emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid}) + + diff --git a/MediaWiki/API/Query/ImageInfo.hs b/MediaWiki/API/Query/ImageInfo.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ImageInfo.hs @@ -0,0 +1,90 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.ImageInfo +-- Description : Representing 'imageinfo' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'imageinfo' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.ImageInfo where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ImageInfo + = ImageInfo + { iiTimestamp :: Timestamp + , iiUser :: UserName + , iiWidth :: Maybe Int + , iiHeight :: Maybe Int + , iiSize :: Maybe Int + , iiURL :: Maybe URLString + , iiComment :: Maybe String + , iiSHA1 :: Maybe String + , iiArchive :: Maybe String + , iiBitDepth :: Maybe Int + , iiMime :: Maybe String + } + +emptyImageInfo :: ImageInfo +emptyImageInfo = ImageInfo + { iiTimestamp = nullTimestamp + , iiUser = nullUser + , iiWidth = Nothing + , iiHeight = Nothing + , iiSize = Nothing + , iiURL = Nothing + , iiComment = Nothing + , iiSHA1 = Nothing + , iiArchive = Nothing + , iiBitDepth = Nothing + , iiMime = Nothing + } + +data ImageInfoRequest + = ImageInfoRequest + { iiProp :: [PropKind] + , iiLimit :: Maybe Int + , iiStart :: Maybe Timestamp + , iiEnd :: Maybe Timestamp + , iiURLSize :: Maybe (Int,Int) + } + +instance APIRequest ImageInfoRequest where + queryKind _ = QProp "imageinfo" + showReq r = + [ opt1 "iiprop" (map prKind $ iiProp r) + , mbOpt "iilimit" show (iiLimit r) + , mbOpt "iistart" id (iiStart r) + , mbOpt "iiend" id (iiEnd r) + , mbOpt "iiurlwidth" (show.fst) (iiURLSize r) + , mbOpt "iiurlheight" (show.snd) (iiURLSize r) + ] + +emptyImageInfoRequest :: ImageInfoRequest +emptyImageInfoRequest = ImageInfoRequest + { iiProp = [] + , iiLimit = Nothing + , iiStart = Nothing + , iiEnd = Nothing + , iiURLSize = Nothing + } + +data ImageInfoResponse + = ImageInfoResponse + { iiPages :: [(PageTitle,[ImageInfo])] + , iiContinue :: Maybe String + } + +emptyImageInfoResponse :: ImageInfoResponse +emptyImageInfoResponse = ImageInfoResponse + { iiPages = [] + , iiContinue = Nothing + } + diff --git a/MediaWiki/API/Query/ImageInfo/Import.hs b/MediaWiki/API/Query/ImageInfo/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ImageInfo/Import.hs @@ -0,0 +1,75 @@ +module MediaWiki.API.Query.ImageInfo.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.ImageInfo + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ImageInfoResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ImageInfoResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 >>= (pNode "pages").children + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "page" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "imageinfo" "iistart" + return emptyImageInfoResponse{iiPages=ps,iiContinue=cont} + +xmlPage :: Element -> Maybe (PageTitle,[ImageInfo]) +xmlPage e = do + guard (elName e == nsName "page") + let es = children e + p <- pNode "imageinfo" es + let es1 = children p + cs <- fmap (mapMaybe (xmlII "ii")) (fmap children $ pNode "ii" es1) + let ns = fromMaybe "0" $ pAttr "ns" p + let tit = fromMaybe "" $ pAttr "title" p + let mbpid = pAttr "pageid" p + let miss = isJust (pAttr "missing" p) + let rep = pAttr "imagerepository" p + return (emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid}, cs) + +xmlII :: String -> Element -> Maybe ImageInfo +xmlII tg p = do + guard (elName p == nsName tg) + let ts = fromMaybe nullTimestamp (pAttr "timestamp" p) + let us = fromMaybe nullUser (pAttr "user" p) + let wi = pAttr "width" p >>= readI + let he = pAttr "height" p >>= readI + let si = pAttr "size" p >>= readI + let ur = pAttr "url" p + let co = pAttr "comment" p + let sh = pAttr "sha1" p + let ar = pAttr "archivename" p + let bi = pAttr "bitdepth" p >>= readI + let mi = pAttr "mime" p + return emptyImageInfo + { iiTimestamp = ts + , iiUser = us + , iiWidth = wi + , iiHeight = he + , iiSize = si + , iiURL = ur + , iiComment = co + , iiSHA1 = sh + , iiArchive = ar + , iiBitDepth = bi + , iiMime = mi + } + + +readI :: String -> Maybe Int +readI s = + case reads s of + ((v,_):_) -> Just v + _ -> Nothing + + diff --git a/MediaWiki/API/Query/ImageUsage.hs b/MediaWiki/API/Query/ImageUsage.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ImageUsage.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.ImageUsage +-- Description : Representing 'imageusage' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'imageusage' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.ImageUsage where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ImageUsageRequest + = ImageUsageRequest + { iuTitle :: Maybe String + , iuContinueFrom :: Maybe String + , iuNamespace :: [NamespaceID] + , iuFilterRedir :: Maybe Redirect + , iuRedirect :: Bool + , iuLimit :: Maybe Int + } + +instance APIRequest ImageUsageRequest where + queryKind _ = QList "imageusage" + showReq r = + [ mbOpt "iutitle" id (iuTitle r) + , mbOpt "iucontinue" id (iuContinueFrom r) + , opt1 "iunamespace" (iuNamespace r) + , mbOpt "iufilterredir" id (iuFilterRedir r) + , optB "iuredirect" (iuRedirect r) + , mbOpt "iulimit" show (iuLimit r) + ] + +emptyImageUsageRequest :: ImageUsageRequest +emptyImageUsageRequest = ImageUsageRequest + { iuTitle = Nothing + , iuContinueFrom = Nothing + , iuNamespace = [] + , iuFilterRedir = Nothing + , iuRedirect = False + , iuLimit = Nothing + } + +data ImageUsageResponse + = ImageUsageResponse + { iuLinks :: [PageTitle] + , iuContinue :: Maybe String + } + +emptyImageUsageResponse :: ImageUsageResponse +emptyImageUsageResponse + = ImageUsageResponse + { iuLinks = [] + , iuContinue = Nothing + } diff --git a/MediaWiki/API/Query/ImageUsage/Import.hs b/MediaWiki/API/Query/ImageUsage/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/ImageUsage/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.ImageUsage.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.ImageUsage + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ImageUsageResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ImageUsageResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "imageusage" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "imageusage" "iucontinue" + return emptyImageUsageResponse{iuLinks=ps,iuContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "iu") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let mbpid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=mbpid} diff --git a/MediaWiki/API/Query/Images.hs b/MediaWiki/API/Query/Images.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Images.hs @@ -0,0 +1,49 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Images +-- Description : Representing 'images' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'images' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Images where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data ImagesRequest + = ImagesRequest + { imLimit :: Maybe Int + , imContinueFrom :: Maybe String + } + +instance APIRequest ImagesRequest where + queryKind _ = QProp "images" + showReq r = + [ mbOpt "imlimit" show (imLimit r) + , mbOpt "imcontinue" id (imContinueFrom r) + ] + +emptyImagesRequest :: ImagesRequest +emptyImagesRequest = ImagesRequest + { imLimit = Nothing + , imContinueFrom = Nothing + } + +data ImagesResponse + = ImagesResponse + { imLinks :: [(PageTitle,[PageTitle])] + , imContinue :: Maybe String + } + +emptyImagesResponse :: ImagesResponse +emptyImagesResponse = ImagesResponse + { imLinks = [] + , imContinue = Nothing + } diff --git a/MediaWiki/API/Query/Images/Import.hs b/MediaWiki/API/Query/Images/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Images/Import.hs @@ -0,0 +1,42 @@ +module MediaWiki.API.Query.Images.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Images + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) ImagesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe ImagesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "imageinfo" "iistart" + return emptyImagesResponse{imLinks=ps,imContinue=cont} + +xmlPage :: Element -> Maybe (PageTitle,[PageTitle]) +xmlPage e = do + guard (elName e == nsName "page") + let pid = fmap read $ pAttr "pageid" e + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let es = children e + ls <- fmap (mapMaybe xmlIm) (fmap children $ pNode "images" es) + let pg = emptyPageTitle{pgNS=ns,pgMbId=pid,pgTitle=tit} + return (pg, ls) + +xmlIm :: Element -> Maybe PageTitle +xmlIm e = do + guard (elName e == nsName "im") + let ns = fromMaybe ns_IMAGE $ pAttr "ns" e + let ti = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=ti,pgMbId=pid} diff --git a/MediaWiki/API/Query/Info.hs b/MediaWiki/API/Query/Info.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Info.hs @@ -0,0 +1,90 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Info +-- Description : Representing 'info' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'info' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Info where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data InfoRequest + = InfoRequest + { inProps :: [String] + , inTokens :: [String] + } + +instance APIRequest InfoRequest where + queryKind _ = QProp "info" + showReq r = + [ opt1 "inprop" (inProps r) + , opt1 "intoken" (inTokens r) + ] + +emptyInfoRequest :: InfoRequest +emptyInfoRequest = InfoRequest + { inProps = [] + , inTokens = [] + } + +data InfoResponse + = InfoResponse + { infPages :: [InfoPage] + } + +data InfoPage + = InfoPage + { infPage :: PageTitle + , infTouched :: TimeString + , infLastRevId :: RevID + , infCounter :: Integer + , infLength :: Integer + , infIsRedirect :: Bool + , infIsNew :: Bool + , infEditTok :: Maybe Token + , infDeleteTok :: Maybe Token + , infProtectTok :: Maybe Token + , infMoveTok :: Maybe Token + , infProtection :: [PageRestriction] + } + +emptyInfoResponse :: InfoResponse +emptyInfoResponse = + InfoResponse{ infPages= [] + } + +emptyInfoPage :: InfoPage +emptyInfoPage = + InfoPage + { infPage = emptyPageTitle + , infTouched = "" + , infLastRevId = "" + , infCounter = 0 + , infLength = 0 + , infIsRedirect = False + , infIsNew = False + , infEditTok = Nothing + , infDeleteTok = Nothing + , infProtectTok = Nothing + , infMoveTok = Nothing + , infProtection = [] + } + +data PageRestriction + = PageRestriction + { prPageId :: PageID + , prSource :: PageName + , prType :: String + , prLevel :: Integer + , prExpiry :: TimeString + , prCascade :: Bool + } diff --git a/MediaWiki/API/Query/Info/Import.hs b/MediaWiki/API/Query/Info/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Info/Import.hs @@ -0,0 +1,54 @@ +module MediaWiki.API.Query.Info.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Info + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) InfoResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe InfoResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + return emptyInfoResponse{infPages=ps} + +xmlPage :: Element -> Maybe InfoPage +xmlPage e = do + guard (elName e == nsName "page") + let touched = fromMaybe "" $ pAttr "touched" e + let rvid = fromMaybe "0" $ pAttr "lastrevid" e + let cnt = fromMaybe 0 $ (pAttr "counter" e >>= readMb) + let len = fromMaybe 0 $ (pAttr "length" e >>= readMb) + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let miss = fromMaybe False $ fmap (const True) $ pAttr "missing" e + let red = fromMaybe False $ fmap (const True) $ pAttr "redirect" e + let new = fromMaybe False $ fmap (const True) $ pAttr "new" e + let edTok = pAttr "edittoken" e + let deTok = pAttr "deletetoken" e + let prTok = pAttr "protecttoken" e + let moTok = pAttr "movetoken" e + return emptyInfoPage + { infPage = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid,pgMissing=miss} + , infTouched = touched + , infLastRevId = rvid + , infCounter = cnt + , infLength = len + , infIsRedirect = red + , infIsNew = new + , infEditTok = edTok + , infDeleteTok = deTok + , infProtectTok = prTok + , infMoveTok = moTok + , infProtection = [] + } diff --git a/MediaWiki/API/Query/LangLinks.hs b/MediaWiki/API/Query/LangLinks.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/LangLinks.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.LangLinks +-- Description : Representing 'langlinks' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'langlinks' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.LangLinks where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data LangLinksRequest + = LangLinksRequest + { llLimit :: Maybe Int + , llContinueFrom :: Maybe String + } + +instance APIRequest LangLinksRequest where + queryKind _ = QProp "langlinks" + showReq r + = [ mbOpt "lllimit" show (llLimit r) + , mbOpt "llcontinue" id (llContinueFrom r) + ] + +emptyLangLinksRequest :: LangLinksRequest +emptyLangLinksRequest = LangLinksRequest + { llLimit = Nothing + , llContinueFrom = Nothing + } + +data LangLinksResponse + = LangLinksResponse + { llPages :: [(PageTitle,[LangPageInfo])] + , llContinue :: Maybe String + } + +emptyLangLinksResponse :: LangLinksResponse +emptyLangLinksResponse = LangLinksResponse + { llPages = [] + , llContinue = Nothing + } + +data LangPageInfo + = LangPageInfo + { langName :: LangName + , langTitle :: Maybe String + } + +emptyLangPageInfo :: LangPageInfo +emptyLangPageInfo = LangPageInfo + { langName = "en" + , langTitle = Nothing + } + diff --git a/MediaWiki/API/Query/LangLinks/Import.hs b/MediaWiki/API/Query/LangLinks/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/LangLinks/Import.hs @@ -0,0 +1,45 @@ +module MediaWiki.API.Query.LangLinks.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.LangLinks + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) LangLinksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe LangLinksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "langlinks" "llcontinue" + return emptyLangLinksResponse + { llPages = ps + , llContinue = cont + } + +xmlPage :: Element -> Maybe (PageTitle,[LangPageInfo]) +xmlPage e = do + guard (elName e == nsName "page") + let pid = fmap read $ pAttr "pageid" e + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let es = children e + ls <- fmap (mapMaybe xmlLangLink) (fmap children $ pNode "langlinks" es) + let pg = emptyPageTitle{pgNS=ns,pgMbId=pid,pgTitle=tit} + return (pg, ls) + +xmlLangLink :: Element -> Maybe LangPageInfo +xmlLangLink e = do + guard (elName e == nsName "ll") + let la = fromMaybe "en" $ pAttr "lang" e + let tit = case strContent e of { "" -> Nothing ; xs -> Just xs} + return emptyLangPageInfo{langName=la,langTitle=tit} diff --git a/MediaWiki/API/Query/Links.hs b/MediaWiki/API/Query/Links.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Links.hs @@ -0,0 +1,55 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Links +-- Description : Representing 'links' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'links' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Links where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data LinksRequest + = LinksRequest + { plNamespaces :: [NamespaceID] + , plLimit :: Maybe Int + , plContinueFrom :: Maybe String + } + +instance APIRequest LinksRequest where + queryKind _ = QProp "links" + showReq r + = [ opt1 "plnamespace" (plNamespaces r) + , mbOpt "pllimit" show (plLimit r) + , mbOpt "plcontinue" id (plContinueFrom r) + ] + + +emptyLinksRequest :: LinksRequest +emptyLinksRequest + = LinksRequest + { plNamespaces = [] + , plLimit = Nothing + , plContinueFrom = Nothing + } + +data LinksResponse + = LinksResponse + { plPages :: [(PageTitle,[PageTitle])] + , plContinue :: Maybe String + } + +emptyLinksResponse :: LinksResponse +emptyLinksResponse = LinksResponse + { plPages = [] + , plContinue = Nothing + } + diff --git a/MediaWiki/API/Query/Links/Import.hs b/MediaWiki/API/Query/Links/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Links/Import.hs @@ -0,0 +1,45 @@ +module MediaWiki.API.Query.Links.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Links + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) LinksResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe LinksResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "langlinks" "llcontinue" + return emptyLinksResponse + { plPages = ps + , plContinue = cont + } + +xmlPage :: Element -> Maybe (PageTitle,[PageTitle]) +xmlPage e = do + guard (elName e == nsName "page") + let pid = fmap read $ pAttr "pageid" e + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let es = children e + ls <- fmap (mapMaybe xmlPageLink) (fmap children $ pNode "links" es) + let pg = emptyPageTitle{pgNS=ns,pgMbId=pid,pgTitle=tit} + return (pg,ls) + +xmlPageLink :: Element -> Maybe PageTitle +xmlPageLink e = do + guard (elName e == nsName "pl") + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/LogEvents.hs b/MediaWiki/API/Query/LogEvents.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/LogEvents.hs @@ -0,0 +1,114 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.LogEvents +-- Description : Representing 'logevents' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'logevents' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.LogEvents where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data LogEventsRequest + = LogEventsRequest + { leProp :: [String] + , leType :: [String] + , leStart :: Maybe Timestamp + , leEnd :: Maybe Timestamp + , leDir :: Maybe TimeArrow + , leUser :: Maybe UserID + , leTitle :: Maybe PageName + , leLimit :: Maybe Int + } + +instance APIRequest LogEventsRequest where + queryKind _ = QList "logevents" + showReq r = + [ opt1 "leprop" (leProp r) + , opt1 "letype" (leType r) + , mbOpt "lestart" id (leStart r) + , mbOpt "leend" id (leEnd r) + , mbOpt "ledir" (\ x -> if x==Earlier then "older" else "newer") (leDir r) + , mbOpt "leuser" id (leUser r) + , mbOpt "letitle" id (leTitle r) + , mbOpt "lelimit" show (leLimit r) + ] + +emptyLogEventsRequest :: LogEventsRequest +emptyLogEventsRequest = LogEventsRequest + { leProp = [] + , leType = [] + , leStart = Nothing + , leEnd = Nothing + , leDir = Nothing + , leUser = Nothing + , leTitle = Nothing + , leLimit = Nothing + } + +data LogEventsResponse + = LogEventsResponse + { leEvents :: [LogEvent] + , leContinue :: Maybe String + } + +emptyLogEventsResponse :: LogEventsResponse +emptyLogEventsResponse = LogEventsResponse + { leEvents = [] + , leContinue = Nothing + } + +data LogEvent + = LogEvent + { levLogId :: Maybe String + , levPage :: PageTitle + , levType :: Maybe String + , levAction :: Maybe String + , levParams :: [LogEventParam] + , levUser :: Maybe String + , levTimestamp :: Maybe Timestamp + , levComment :: Maybe String + } + +emptyLogEvent :: LogEvent +emptyLogEvent + = LogEvent + { levLogId = Nothing + , levPage = emptyPageTitle + , levType = Nothing + , levAction = Nothing + , levParams = [] + , levUser = Nothing + , levTimestamp = Nothing + , levComment = Nothing + } + +data LogEventParam + = LogEventMove + { levMovePage :: PageTitle } + | LogEventPatrol + { levPatrolCurrent :: Maybe String + , levPatrolPrevious :: Maybe String + , levPatrolAuto :: Maybe String + } + | LogEventRights + { levRightsOld :: Maybe String + , levRightsNew :: Maybe String + } + | LogEventBlock + { levBlockDuration :: Maybe String + , levBlockFlags :: Maybe String + } + | LogEventParam {levParamValue :: String } + | LogEventOther + { levParamName :: String + , levParamAttrs :: [(String,String)] + } diff --git a/MediaWiki/API/Query/LogEvents/Import.hs b/MediaWiki/API/Query/LogEvents/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/LogEvents/Import.hs @@ -0,0 +1,81 @@ +module MediaWiki.API.Query.LogEvents.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.LogEvents + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) LogEventsResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe LogEventsResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "logevents" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "logevents" "lestart" + return emptyLogEventsResponse + { leEvents = ps + , leContinue = cont + } + +xmlPage :: Element -> Maybe LogEvent +xmlPage e = do + guard (elName e == nsName "item") + let pid = pAttr "pageid" e + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let ty = pAttr "type" e + let act = pAttr "action" e + let usr = pAttr "user" e + let ts = pAttr "timestamp" e + let co = pAttr "comment" e + let lid = pAttr "logid" e + let ps = mapMaybe xmlParam (children e) + let pg = emptyPageTitle{pgNS=ns,pgMbId=pid,pgTitle=tit} + return emptyLogEvent + { levLogId = lid + , levPage = pg + , levType = ty + , levAction = act + , levParams = ps + , levUser = usr + , levTimestamp = ts + , levComment = co + } + +xmlParam :: Element -> Maybe LogEventParam +xmlParam e = do + case qName (elName e) of + "move" -> do + let ns = fromMaybe mainNamespace $ pAttr "new_ns" e + let tit = fromMaybe "" $ pAttr "new_title" e + let pid = pAttr "new_pageid" e + return (LogEventMove emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid}) + "patrol" -> do + let cur = pAttr "cur" e + let pre = pAttr "prev" e + let auto = pAttr "auto" e + return (LogEventPatrol{levPatrolCurrent=cur,levPatrolPrevious=pre,levPatrolAuto=auto}) + "rights" -> do + let old = pAttr "old" e + let new = pAttr "new" e + return (LogEventRights{levRightsOld=old,levRightsNew=new}) + "block" -> do + let dur = pAttr "duration" e + let fla = pAttr "flags" e + return (LogEventBlock{levBlockDuration=dur,levBlockFlags=fla}) + "param" -> return (LogEventParam (strContent e)) + tg -> return $ + LogEventOther{ levParamName = tg + , levParamAttrs = map (\a -> (qName $ attrKey a,attrVal a)) + (elAttribs e)} + + diff --git a/MediaWiki/API/Query/Random.hs b/MediaWiki/API/Query/Random.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Random.hs @@ -0,0 +1,47 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Random +-- Description : Representing 'random' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'random' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Random where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data RandomPagesRequest + = RandomPagesRequest + { rnNamespaces :: [NamespaceID] + , rnLimit :: Maybe Int + } + +instance APIRequest RandomPagesRequest where + queryKind _ = QList "random" + showReq r = [ opt1 "rnnamespace" (rnNamespaces r) + , mbOpt "rnlimit" show (rnLimit r) + ] + +emptyRandomPagesRequest :: RandomPagesRequest +emptyRandomPagesRequest = RandomPagesRequest + { rnNamespaces = [] + , rnLimit = Nothing + } + +data RandomPagesResponse + = RandomPagesResponse + { rnPages :: [PageTitle] + } + +emptyRandomPagesResponse :: RandomPagesResponse +emptyRandomPagesResponse + = RandomPagesResponse + { rnPages = [] + } diff --git a/MediaWiki/API/Query/Random/Import.hs b/MediaWiki/API/Query/Random/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Random/Import.hs @@ -0,0 +1,31 @@ +module MediaWiki.API.Query.Random.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Random + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) RandomPagesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe RandomPagesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "random" es) + return emptyRandomPagesResponse{rnPages=ps} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/RecentChanges.hs b/MediaWiki/API/Query/RecentChanges.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/RecentChanges.hs @@ -0,0 +1,110 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.RecentChanges +-- Description : Representing 'recentchanges' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'recentchanges' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.RecentChanges where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data RecentChangesRequest + = RecentChangesRequest + { rcStart :: Maybe Timestamp + , rcEnd :: Maybe Timestamp + , rcDir :: Maybe TimeArrow + , rcNamespaces :: [NamespaceID] + , rcTitles :: [PageName] + , rcProp :: [String] + , rcShow :: [String] + , rcLimit :: Maybe Int + , rcType :: [String] -- edit,new,log + } + +instance APIRequest RecentChangesRequest where + queryKind _ = QList "recentchanges" + showReq r = + [ mbOpt "rcstart" id (rcStart r) + , mbOpt "rcend" id (rcEnd r) + , mbOpt "rcdir" (\ x -> if x == Earlier then "older" else "newer") (rcDir r) + , opt1 "rcnamespace" (rcNamespaces r) + , opt1 "rctitles" (rcTitles r) + , opt1 "rcprop" (rcProp r) + , opt1 "rcshow" (rcShow r) + , mbOpt "rclimit" show (rcLimit r) + , opt1 "rctype" (rcType r) + ] + +emptyRecentChangesRequest :: RecentChangesRequest +emptyRecentChangesRequest = RecentChangesRequest + { rcStart = Nothing + , rcEnd = Nothing + , rcDir = Nothing + , rcNamespaces = [] + , rcTitles = [] + , rcProp = [] + , rcShow = [] + , rcLimit = Nothing + , rcType = [] + } + + +data RecentChangesResponse + = RecentChangesResponse + { rchChanges :: [RecentChange] + , rchContinue :: Maybe String + } + +emptyRecentChangesResponse :: RecentChangesResponse +emptyRecentChangesResponse = RecentChangesResponse + { rchChanges = [] + , rchContinue = Nothing + } + +data RecentChange + = RecentChange + { rchType :: Maybe String + , rchPage :: PageTitle + , rchPageTo :: Maybe PageTitle + , rchRcId :: Maybe RevID + , rchRevId :: Maybe RevID + , rchRevOldId :: Maybe RevID + , rchUser :: Maybe UserName + , rchIsAnon :: Bool + , rchIsBot :: Bool + , rchIsNew :: Bool + , rchIsMinor :: Bool + , rchLength :: Maybe Int + , rchLengthOld :: Maybe Int + , rchTimestamp :: Maybe String + , rchComment :: Maybe String + } + +emptyRecentChange :: RecentChange +emptyRecentChange + = RecentChange + { rchType = Nothing + , rchPage = emptyPageTitle + , rchPageTo = Nothing + , rchRcId = Nothing + , rchRevId = Nothing + , rchRevOldId = Nothing + , rchUser = Nothing + , rchIsAnon = False + , rchIsBot = False + , rchIsNew = False + , rchIsMinor = False + , rchLength = Nothing + , rchLengthOld = Nothing + , rchTimestamp = Nothing + , rchComment = Nothing + } diff --git a/MediaWiki/API/Query/RecentChanges/Import.hs b/MediaWiki/API/Query/RecentChanges/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/RecentChanges/Import.hs @@ -0,0 +1,80 @@ +module MediaWiki.API.Query.RecentChanges.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.RecentChanges + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) RecentChangesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe RecentChangesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "recentchanges" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "recentchanges" "rcstart" + return emptyRecentChangesResponse + { rchChanges = ps + , rchContinue = cont + } + +xmlPage :: Element -> Maybe RecentChange +xmlPage e = do + guard (elName e == nsName "rc") + let ty = pAttr "type" e + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let ns_t = pAttr "new_ns" e + let tit_t = pAttr "new_title" e + let pid_t = pAttr "new_pageid" e + let pg_to + | any isJust [ns_t,tit_t,pid_t] + = Just + emptyPageTitle{ pgNS=fromMaybe mainNamespace ns_t + , pgTitle=fromMaybe "" tit_t + , pgMbId=pid_t + } + | otherwise = Nothing + let rcid = pAttr "rcid" e + let revid = pAttr "revid" e + let revido = pAttr "old_revid" e + let usr = pAttr "user" e + let isa = isJust (pAttr "anon" e) + let isb = isJust (pAttr "bot" e) + let isn = isJust (pAttr "new" e) + let ism = isJust (pAttr "minor" e) + let len = pAttr "newlen" e >>= readMb + let leno = pAttr "oldlen" e >>= readMb + let ts = pAttr "timestamp" e + let co = pAttr "comment" e + return emptyRecentChange + { rchType = ty + , rchPage = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} + , rchPageTo = pg_to + , rchRcId = rcid + , rchRevId = revid + , rchRevOldId = revido + , rchUser = usr + , rchIsAnon = isa + , rchIsBot = isb + , rchIsNew = isn + , rchIsMinor = ism + , rchLength = len + , rchLengthOld = leno + , rchTimestamp = ts + , rchComment = co + } + + + + + diff --git a/MediaWiki/API/Query/Revisions.hs b/MediaWiki/API/Query/Revisions.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Revisions.hs @@ -0,0 +1,110 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Revisions +-- Description : Representing 'revisions' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'revisions' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Revisions where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data RevisionRequest + = RevisionRequest + { rvProp :: [String] + , rvLimit :: Maybe Int + , rvStartID :: Maybe RevID + , rvEndID :: Maybe RevID + , rvStart :: Maybe TimeString + , rvEnd :: Maybe TimeString + , rvDir :: Maybe Direction + , rvUser :: Maybe UserName + , rvExcludeUser :: Maybe UserName + , rvExpandTemplates :: Maybe Bool + , rvSection :: Maybe String + , rvTokens :: [String] + } + +instance APIRequest RevisionRequest where + queryKind _ = QProp "revisions" + showReq r = + [ opt1 "rvprop" (rvProp r) + , mbOpt "rvlimit" show (rvLimit r) + , mbOpt "rvstartid" id (rvStartID r) + , mbOpt "rvendid" id (rvEndID r) + , mbOpt "rvstart" id (rvStart r) + , mbOpt "rvend" id (rvEnd r) + , mbOpt "rvdir" (\ x -> if x == Up then "ascending" else "descending") + (rvDir r) + , mbOpt "rvuser" id (rvUser r) + , mbOpt "rvexcludeuser" id (rvExcludeUser r) + , optB "rvexpandtemplates" (fromMaybe False (rvExpandTemplates r)) + , mbOpt "rvsection" id (rvSection r) + , opt1 "rvtoken" (rvTokens r) + ] + + +emptyRevisionRequest :: RevisionRequest +emptyRevisionRequest = RevisionRequest + { rvProp = [] + , rvLimit = Nothing + , rvStartID = Nothing + , rvEndID = Nothing + , rvStart = Nothing + , rvEnd = Nothing + , rvDir = Nothing + , rvUser = Nothing + , rvExcludeUser = Nothing + , rvExpandTemplates = Nothing + , rvTokens = [] + , rvSection = Nothing + } + +data RevisionsResponse + = RevisionsResponse + { rvPages :: [(PageTitle,[Revision])] + , rvContinue :: Maybe String + } + +emptyRevisionsResponse :: RevisionsResponse +emptyRevisionsResponse + = RevisionsResponse + { rvPages = [] + , rvContinue = Nothing + } + +data Revision + = Revision + { revPage :: PageTitle + , revRevId :: RevID + , revIsMinor :: Bool + , revUser :: String + , revIsAnon :: Bool + , revTimestamp :: TimeString + , revSize :: Integer + , revComment :: Maybe String +-- , revRollbackToken :: Maybe Token + , revContent :: Maybe String + } + +emptyRevision :: PageTitle -> Revision +emptyRevision pg + = Revision + { revPage = pg + , revRevId = nullRevId + , revIsMinor = False + , revUser = nullUser + , revIsAnon = False + , revTimestamp = nullTimestamp + , revSize = 0 + , revComment = Nothing + , revContent = Nothing + } diff --git a/MediaWiki/API/Query/Revisions/Import.hs b/MediaWiki/API/Query/Revisions/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Revisions/Import.hs @@ -0,0 +1,62 @@ +module MediaWiki.API.Query.Revisions.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Revisions + +import Text.XML.Light.Types +import Text.XML.Light.Input ( parseXMLDoc ) +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) RevisionsResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe RevisionsResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "revisions" "rvstartid" + return emptyRevisionsResponse + { rvPages = ps + , rvContinue = cont + } + +xmlPage :: Element -> Maybe (PageTitle,[Revision]) +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe mainNamespace $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let es = children e + p <- pNode "revisions" es + let pg = emptyPageTitle{pgNS = ns, pgTitle=tit, pgMbId = pid} + rs <- fmap (mapMaybe (xmlRevision pg)) (fmap children $ pNode "rev" es) + return (pg, rs) + +xmlRevision :: PageTitle -> Element -> Maybe Revision +xmlRevision pg e = do + guard (elName e == nsName "page") + let rid = fromMaybe "" $ pAttr "revid" e + let min = isJust (pAttr "minor" e) + let usr = fromMaybe "" $ pAttr "user" e + let anon = isJust (pAttr "anon" e) + let ts = fromMaybe "" $ pAttr "timestamp" e + let size = fromMaybe 0 (pAttr "size" e >>= readMb) + let com = pAttr "comment" e + let con = case strContent e of { "" -> Nothing ; xs -> Just xs} + return (emptyRevision pg) + { revRevId = rid + , revIsMinor = min + , revUser = usr + , revIsAnon = anon + , revTimestamp = ts + , revSize = size + , revComment = com + , revContent = con + } diff --git a/MediaWiki/API/Query/Search.hs b/MediaWiki/API/Query/Search.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Search.hs @@ -0,0 +1,62 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Search +-- Description : Representing 'search' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'search' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Search where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data SearchRequest + = SearchRequest + { srSearch :: String + , srNamespaces :: [NamespaceID] + , srWhat :: Bool -- True => (full)text search, o/w title search. + , srRedirects :: Bool + , srOffset :: Maybe String + , srLimit :: Maybe Int + } + +instance APIRequest SearchRequest where + queryKind _ = QList "search" + showReq r + = [ mbOpt "srsearch" id (Just (srSearch r)) + , opt1 "srnamespace" (srNamespaces r) + , opt "srwhat" ((\x -> if x then "text" else "title") (srWhat r)) + , optB "srredirects" (srRedirects r) + , mbOpt "sroffset" id (srOffset r) + , mbOpt "srlimit" show (srLimit r) + ] + +emptySearchRequest :: String -> SearchRequest +emptySearchRequest s = SearchRequest + { srSearch = s + , srNamespaces = [] + , srWhat = False + , srRedirects = False + , srOffset = Nothing + , srLimit = Nothing + } + +data SearchResponse + = SearchResponse + { srPages :: [PageTitle] + , srContinue :: Maybe String + } + +emptySearchResponse :: SearchResponse +emptySearchResponse = SearchResponse + { srPages = [] + , srContinue = Nothing + } + diff --git a/MediaWiki/API/Query/Search/Import.hs b/MediaWiki/API/Query/Search/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Search/Import.hs @@ -0,0 +1,32 @@ +module MediaWiki.API.Query.Search.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Search + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) SearchResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe SearchResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "search" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "search" "sroffset" + return emptySearchResponse{srPages=ps,srContinue=cont} + +xmlPage :: Element -> Maybe PageTitle +xmlPage e = do + guard (elName e == nsName "p") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/SiteInfo.hs b/MediaWiki/API/Query/SiteInfo.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/SiteInfo.hs @@ -0,0 +1,114 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.SiteInfo +-- Description : Representing 'siteinfo' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'siteinfo' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.SiteInfo where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data SiteInfoRequest + = SiteInfoRequest + { siProp :: [String] -- general,namespaces,namespacealiases, + -- specialpagealiases,statistics,interwikimap, + -- dbrepllag,usergroups + , siFilterIW :: Maybe Bool + , siShowAllDBs :: Bool + } + +instance APIRequest SiteInfoRequest where + queryKind _ = QMeta "siteinfo" + showReq r + = [ opt1 "siprop" (siProp r) + , mbOpt "sifilteriw" ( \x -> if x then "local" else "!local") (siFilterIW r) + , optB "sishowalldb" (siShowAllDBs r) + ] + +emptySiteInfoRequest :: SiteInfoRequest +emptySiteInfoRequest = SiteInfoRequest + { siProp = [] + , siFilterIW = Nothing + , siShowAllDBs = False + } + +data SiteInfoResponse + = SiteInfoResponse + { siDBReplInfo :: [DBInfo] + , siNamespaces :: [NamespaceInfo] + , siGeneral :: Maybe SiteInfo + , siNamespaceAliases :: [NamespaceInfo] + , siSpecialPageAliases :: [(String,[String])] + , siStatistics :: Maybe SiteStatistics + , siInterwiki :: [InterwikiEntry] + , siUserGroups :: [UserGroup] + } + +emptySiteInfoResponse :: SiteInfoResponse +emptySiteInfoResponse = SiteInfoResponse + { siDBReplInfo = [] + , siNamespaces = [] + , siGeneral = Nothing + , siNamespaceAliases = [] + , siSpecialPageAliases = [] + , siStatistics = Nothing + , siInterwiki = [] + , siUserGroups = [] + } + +type Permission = String + +data UserGroup + = UserGroup + { ugName :: String + , ugRights :: [Permission] + } + +data SiteInfo + = SiteInfo + { siteMainPage :: PageName + , siteBase :: URLString + , siteName :: String + , siteGenerator :: String + , siteLastRevision :: Maybe String + , siteCase :: Maybe String + , siteRightsCode :: Maybe String + , siteRights :: Maybe String + , siteLang :: Maybe String + , siteFallbackEncoding :: Maybe String + , siteWriteAPI :: Bool + , siteTimezone :: Maybe String + , siteTZOffset :: Maybe Int + } + +data SiteStatistics + = SiteStatistics + { siPages :: Integer + , siArticles :: Integer + , siViews :: Integer + , siEdits :: Integer + , siImages :: Integer + , siUsers :: Integer + , siAdmins :: Integer + , siJobs :: Integer + } + + + +data DBInfo + = DBInfo + { dbHost :: String + , dbLag :: String + } + + + diff --git a/MediaWiki/API/Query/SiteInfo/Import.hs b/MediaWiki/API/Query/SiteInfo/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/SiteInfo/Import.hs @@ -0,0 +1,143 @@ +module MediaWiki.API.Query.SiteInfo.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.SiteInfo + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) SiteInfoResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe SiteInfoResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + let dbs = fromMaybe [] $ fmap (mapMaybe xmlDB) (fmap children $ pNode "dblrepllag" es) + let nss = fromMaybe [] $ fmap (mapMaybe xmlNS) (fmap children $ pNode "namespaces" es) + let nass = fromMaybe [] $ fmap (mapMaybe xmlNS) (fmap children $ pNode "namespacealiases" es) + let gen = pNode "general" es >>= xmlSI + let ss = fromMaybe [] $ fmap (mapMaybe xmlSS) (fmap children $ pNode "specialpagealiases" es) + let st = pNode "statistics" es >>= xmlStat + let iws = fromMaybe [] $ fmap (mapMaybe xmlIW) (fmap children $ pNode "interwikimap" es) + let ugs = fromMaybe [] $ fmap (mapMaybe xmlGr) (fmap children $ pNode "usergroups" es) + return + emptySiteInfoResponse + { siDBReplInfo = dbs + , siNamespaces = nss + , siGeneral = gen + , siNamespaceAliases = nass + , siSpecialPageAliases = ss + , siStatistics = st + , siInterwiki = iws + , siUserGroups = ugs + } + +xmlDB :: Element -> Maybe DBInfo +xmlDB e = do + guard (elName e == nsName "db") + let h = fromMaybe "" $ pAttr "host" e + let l = fromMaybe "" $ pAttr "lag" e + return DBInfo{dbHost=h,dbLag=l} + +xmlNS :: Element -> Maybe NamespaceInfo +xmlNS e = do + guard (elName e == nsName "ns") + let i = fromMaybe "" $ pAttr "id" e + let t = strContent e + let sub = isJust (pAttr "subpages" e) + return NamespaceInfo{nsId=i,nsTitle=t,nsSubpages=sub} + +xmlGr :: Element -> Maybe UserGroup +xmlGr e = do + guard (elName e == nsName "group") + let nm = fromMaybe "" $ pAttr "name" e + rs <- fmap (mapMaybe xmlRi) (fmap children $ pNode "rights" (children e)) + return UserGroup{ugName=nm,ugRights=rs} + where + xmlRi p = do + guard (elName p == nsName "permission") + return (strContent e) + +xmlIW :: Element -> Maybe InterwikiEntry +xmlIW e = do + guard (elName e == nsName "iw") + let pre = fromMaybe "" $ pAttr "prefix" e + let url = fromMaybe "" $ pAttr "url" e + let la = pAttr "lang" e + let loc = isJust (pAttr "local" e) + let tra = (pAttr "trans" e >>= \x -> readMb x >>= \ y -> return (y /= (0::Int))) + return InterwikiEntry{iwPrefix=pre,iwLocal=loc,iwTranscludable=tra,iwUrl=url,iwLanguage=la} + +xmlSS :: Element -> Maybe (String,[String]) +xmlSS e = do + guard (elName e == nsName "specialpage") + let es1 = children e + nss <- fmap (mapMaybe xmlAS) (fmap children $ pNode "aliases" es1) + let nm = fromMaybe "" $ pAttr "realname" e + return (nm,nss) + where + xmlAS p = do + guard (elName p == nsName "alias") + return (strContent e) + +xmlSI :: Element -> Maybe SiteInfo +xmlSI e = do + guard (elName e == nsName "general") + let ma = fromMaybe "" $ pAttr "mainpage" e + let ba = fromMaybe "" $ pAttr "base" e + let nm = fromMaybe "" $ pAttr "sitename" e + let ge = fromMaybe "" $ pAttr "generator" e + let re = pAttr "revid" e + let ca = pAttr "case" e + let ri = pAttr "rights" e + let ric = pAttr "rightscode" e + let la = pAttr "lang" e + let enc = pAttr "fallback8bitEncoding" e + let wr = isJust (pAttr "writeapi" e) + let tz = pAttr "timezone" e + let tzo = pAttr "timeoffset" e >>= readMb + return SiteInfo + { siteMainPage = ma + , siteBase = ba + , siteName = nm + , siteGenerator = ge + , siteLastRevision = re + , siteCase = ca + , siteRightsCode = ric + , siteRights = ri + , siteLang = la + , siteFallbackEncoding = enc + , siteWriteAPI = wr + , siteTimezone = tz + , siteTZOffset = tzo + } + +xmlStat :: Element -> Maybe SiteStatistics +xmlStat e = do + guard (elName e == nsName "statistics") + let pgs = fromMaybe 0 $ pAttr "pages" e >>= readMb + let arts = fromMaybe 0 $ pAttr "articles" e >>= readMb + let views = fromMaybe 0 $ pAttr "views" e >>= readMb + let edits = fromMaybe 0 $ pAttr "edits" e >>= readMb + let users = fromMaybe 0 $ pAttr "users" e >>= readMb + let admins = fromMaybe 0 $ pAttr "admins" e >>= readMb + let jobs = fromMaybe 0 $ pAttr "jobs" e >>= readMb + let images = fromMaybe 0 $ pAttr "images" e >>= readMb + return + SiteStatistics + { siPages = pgs + , siArticles = arts + , siViews = views + , siEdits = edits + , siImages = images + , siUsers = users + , siAdmins = admins + , siJobs = jobs + } diff --git a/MediaWiki/API/Query/Templates.hs b/MediaWiki/API/Query/Templates.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Templates.hs @@ -0,0 +1,55 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Templates +-- Description : Representing 'templates' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'templates' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Templates where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data TemplatesRequest + = TemplatesRequest + { tlNamespaces :: [NamespaceID] + , tlLimit :: Maybe Int + , tlContinueFrom :: Maybe String + } + +instance APIRequest TemplatesRequest where + queryKind _ = QProp "templates" + showReq r + = [ opt1 "tlnamespace" (tlNamespaces r) + , mbOpt "tllimit" show (tlLimit r) + , mbOpt "tlcontinue" id (tlContinueFrom r) + ] + +emptyTemplatesRequest :: TemplatesRequest +emptyTemplatesRequest = TemplatesRequest + { tlNamespaces = [] + , tlLimit = Nothing + , tlContinueFrom = Nothing + } + +data TemplatesResponse + = TemplatesResponse + { tlPages :: [(PageTitle,[PageTitle])] + , tlContinue :: Maybe String + } + +emptyTemplatesResponse :: TemplatesResponse +emptyTemplatesResponse = TemplatesResponse + { tlPages = [] + , tlContinue = Nothing + } + + + diff --git a/MediaWiki/API/Query/Templates/Import.hs b/MediaWiki/API/Query/Templates/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Templates/Import.hs @@ -0,0 +1,40 @@ +module MediaWiki.API.Query.Templates.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Templates + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) TemplatesResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe TemplatesResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "pages" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "templates" "tlcontinue" + return emptyTemplatesResponse{tlPages=ps,tlContinue=cont} + +xmlPage :: Element -> Maybe (PageTitle, [PageTitle]) +xmlPage e = do + guard (elName e == nsName "page") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + ps <- fmap (mapMaybe xmlT) (fmap children $ pNode "templates" (children e)) + return (emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid}, ps) + where + xmlT p = do + guard (elName p == nsName "tl") + let ns = fromMaybe "0" $ pAttr "ns" p + let tit = fromMaybe "" $ pAttr "title" p + let pid = pAttr "pageid" p + return emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} diff --git a/MediaWiki/API/Query/UserContribs.hs b/MediaWiki/API/Query/UserContribs.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/UserContribs.hs @@ -0,0 +1,100 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.UserContribs +-- Description : Representing 'usercontribs' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'usercontribs' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.UserContribs where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data UserContribsRequest + = UserContribsRequest + { ucLimit :: Maybe Int + , ucStart :: Maybe Timestamp + , ucEnd :: Maybe Timestamp + , ucUser :: Maybe UserID + , ucUserPrefix :: Maybe String + , ucDir :: Maybe TimeArrow + , ucNamespaces :: [NamespaceID] + , ucProp :: [String] + , ucShow :: [String] + } + +instance APIRequest UserContribsRequest where + queryKind _ = QList "usercontribs" + showReq r + = [ mbOpt "uclimit" show (ucLimit r) + , mbOpt "ucstart" id (ucStart r) + , mbOpt "ucend" id (ucEnd r) + , mbOpt "ucuser" id (ucUser r) + , mbOpt "ucuserprefix" id (ucUserPrefix r) + , mbOpt "ucdir" (\ x -> if x == Earlier then "older" else "newer") (ucDir r) + , opt1 "ucnamespace" (ucNamespaces r) + , opt1 "ucprop" (ucProp r) + , opt1 "ucshow" (ucShow r) + ] + + +emptyUserContribsRequest :: UserContribsRequest +emptyUserContribsRequest = UserContribsRequest + { ucLimit = Nothing + , ucStart = Nothing + , ucEnd = Nothing + , ucUser = Nothing + , ucUserPrefix = Nothing + , ucDir = Nothing + , ucNamespaces = [] + , ucProp = [] + , ucShow = [] + } + +data UserContribsResponse + = UserContribsResponse + { ucPages :: [UserContrib] + , ucContinue :: Maybe String + } + +emptyUserContribsResponse :: UserContribsResponse +emptyUserContribsResponse = UserContribsResponse + { ucPages = [] + , ucContinue = Nothing + } + +data UserContrib + = UserContrib + { ucoUser :: UserName + , ucoPage :: PageTitle + , ucoRevId :: RevID + , ucoTimestamp :: Maybe Timestamp + , ucoIsNew :: Bool + , ucoIsMinor :: Bool + , ucoIsTop :: Bool + , ucoComment :: Maybe String + } + +emptyUserContrib :: UserContrib +emptyUserContrib = UserContrib + { ucoUser = "" + , ucoPage = emptyPageTitle + , ucoRevId = "0" + , ucoTimestamp = Nothing + , ucoIsNew = False + , ucoIsMinor = False + , ucoIsTop = False + , ucoComment = Nothing + } + + + + + diff --git a/MediaWiki/API/Query/UserContribs/Import.hs b/MediaWiki/API/Query/UserContribs/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/UserContribs/Import.hs @@ -0,0 +1,48 @@ +module MediaWiki.API.Query.UserContribs.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.UserContribs + +import Text.XML.Light.Types + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) UserContribsResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe UserContribsResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "usercontribs" es) + let cont = pNode "query-continue" es1 >>= xmlContinue "usercontribs" "ucstart" + return emptyUserContribsResponse{ucPages=ps,ucContinue=cont} + +xmlPage :: Element -> Maybe UserContrib +xmlPage e = do + guard (elName e == nsName "item") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let usr = fromMaybe "" $ pAttr "user" e + let revid = fromMaybe "0" $ pAttr "revid" e + let ts = pAttr "timestamp" e + let isn = isJust (pAttr "new" e) + let ism = isJust (pAttr "minor" e) + let ist = isJust (pAttr "top" e) + let co = pAttr "comment" e + return emptyUserContrib + { ucoUser = usr + , ucoPage = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} + , ucoRevId = revid + , ucoTimestamp = ts + , ucoIsNew = isn + , ucoIsMinor = ism + , ucoIsTop = ist + , ucoComment = co + } + diff --git a/MediaWiki/API/Query/UserInfo.hs b/MediaWiki/API/Query/UserInfo.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/UserInfo.hs @@ -0,0 +1,46 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.UserInfo +-- Description : Representing 'userinfo' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'userinfo' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.UserInfo where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data UserInfoRequest + = UserInfoRequest + { uiProp :: [String] + -- one of (1.13): + -- blockinfo, hasmsg, groups, rights, options, editcount, ratelimits + } + +instance APIRequest UserInfoRequest where + queryKind _ = QMeta "userinfo" + showReq r + = [ opt1 "uiprop" (uiProp r) + ] + +emptyUserInfoRequest :: UserInfoRequest +emptyUserInfoRequest = UserInfoRequest + { uiProp = [] + } + +data UserInfoResponse + = UserInfoResponse + { uiUser :: UserInfo + } + +emptyUserInfoResponse :: UserInfoResponse +emptyUserInfoResponse = UserInfoResponse + { uiUser = emptyUserInfo + } diff --git a/MediaWiki/API/Query/UserInfo/Import.hs b/MediaWiki/API/Query/UserInfo/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/UserInfo/Import.hs @@ -0,0 +1,91 @@ +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,[{-Error msg-}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)) diff --git a/MediaWiki/API/Query/Users.hs b/MediaWiki/API/Query/Users.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Users.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.Users +-- Description : Representing 'users' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'users' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.Users where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data UsersRequest + = UsersRequest + { usProp :: [String] + , usUsers :: [UserID] + } + +instance APIRequest UsersRequest where + queryKind _ = QList "users" + showReq r = [ opt1 "usprop" (usProp r) + , opt1 "ususers" (usUsers r) + ] + +emptyUsersRequest :: UsersRequest +emptyUsersRequest = UsersRequest + { usProp = [] + , usUsers = [] + } + +data UsersResponse + = UsersResponse + { usrUsers :: [UsersInfo] + } + +emptyUsersResponse :: UsersResponse +emptyUsersResponse + = UsersResponse + { usrUsers = [] + } + +data UsersInfo + = UsersInfo + { usName :: Maybe UserName + , usEditCount :: Maybe Int + , usRegDate :: Maybe Timestamp + , usGroups :: [String] + , usBlock :: Maybe (UserName,String) + } + +emptyUsersInfo :: UsersInfo +emptyUsersInfo = UsersInfo + { usName = Nothing + , usEditCount = Nothing + , usRegDate = Nothing + , usGroups = [] + , usBlock = Nothing + } + diff --git a/MediaWiki/API/Query/Users/Import.hs b/MediaWiki/API/Query/Users/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/Users/Import.hs @@ -0,0 +1,47 @@ +module MediaWiki.API.Query.Users.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.Users + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) UsersResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe UsersResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + ps <- fmap (mapMaybe xmlPage) (fmap children $ pNode "users" es) + return emptyUsersResponse{usrUsers=ps} + +xmlPage :: Element -> Maybe UsersInfo +xmlPage e = do + guard (elName e == nsName "user") + let nm = pAttr "name" e + let ec = pAttr "editcount" e >>= readMb + let re = pAttr "registration" e + let bl1 = pAttr "blockedby" e + let bl2 = pAttr "blockreason" e + let bl = case (bl1,bl2) of { (Just a, Just b) -> Just (a,b) ; _ -> Nothing} + let gs = fromMaybe [] $ fmap (mapMaybe xmlG) (fmap children $ pNode "groups" (children e)) + return emptyUsersInfo + { usName = nm + , usEditCount = ec + , usRegDate = re + , usBlock = bl + , usGroups = gs + } + where + xmlG p = do + guard (elName p == nsName "g") + return (strContent p) + + diff --git a/MediaWiki/API/Query/WatchList.hs b/MediaWiki/API/Query/WatchList.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/WatchList.hs @@ -0,0 +1,100 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Query.WatchList +-- Description : Representing 'watchlist' requests. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Representing 'watchlist' requests. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Query.WatchList where + +import MediaWiki.API.Types +import MediaWiki.API.Utils + +data WatchListRequest + = WatchListRequest + { wlAllRev :: Bool + , wlStart :: Maybe Timestamp + , wlEnd :: Maybe Timestamp + , wlNamespaces :: [NamespaceID] + , wlDir :: Maybe TimeArrow + , wlLimit :: Maybe Int + , wlProp :: [String] + , wlShow :: [String] + } + +instance APIRequest WatchListRequest where + queryKind _ = QList "watchlist" + showReq r + = [ optB "wlallrev" (wlAllRev r) + , mbOpt "wlstart" id (wlStart r) + , mbOpt "wlend" id (wlEnd r) + , opt1 "wlnamespace" (wlNamespaces r) + , mbOpt "wldir" (\ x -> if x==Earlier then "older" else "newer") + (wlDir r) + , mbOpt "wllimit" show (wlLimit r) + , opt1 "wlprop" (wlProp r) + , opt1 "wlshow" (wlShow r) + ] + +emptyWatchListRequest :: WatchListRequest +emptyWatchListRequest = WatchListRequest + { wlAllRev = False + , wlStart = Nothing + , wlEnd = Nothing + , wlNamespaces = [] + , wlDir = Nothing + , wlLimit = Nothing + , wlProp = [] + , wlShow = [] + } + +data WatchListResponse + = WatchListResponse + { wlWatch :: WatchList + , wlContinue :: Maybe String + } + +emptyWatchListResponse :: WatchListResponse +emptyWatchListResponse = WatchListResponse + { wlWatch = emptyWatchList + , wlContinue = Nothing + } + +data WatchList + = WatchList + { wlPage :: PageTitle + , wlRevId :: Maybe RevID + , wlUser :: Maybe UserName + , wlIsAnon :: Bool + , wlIsNew :: Bool + , wlIsMinor :: Bool + , wlIsPatrolled :: Bool + , wlTimestamp :: Maybe Timestamp + , wlLength :: Maybe Int + , wlOldLength :: Maybe Int + , wlComment :: Maybe String + } + +emptyWatchList :: WatchList +emptyWatchList + = WatchList + { wlPage = emptyPageTitle + , wlRevId = Nothing + , wlUser = Nothing + , wlIsAnon = False + , wlIsNew = False + , wlIsMinor = False + , wlIsPatrolled = False + , wlTimestamp = Nothing + , wlLength = Nothing + , wlOldLength = Nothing + , wlComment = Nothing + } + diff --git a/MediaWiki/API/Query/WatchList/Import.hs b/MediaWiki/API/Query/WatchList/Import.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Query/WatchList/Import.hs @@ -0,0 +1,56 @@ +module MediaWiki.API.Query.WatchList.Import where + +import MediaWiki.API.Types +import MediaWiki.API.Utils +import MediaWiki.API.Query.WatchList + +import Text.XML.Light.Types +import Text.XML.Light.Proc ( strContent ) + +import Control.Monad +import Data.Maybe + +stringXml :: String -> Either (String,[{-Error msg-}String]) WatchListResponse +stringXml s = parseDoc xml s + +xml :: Element -> Maybe WatchListResponse +xml e = do + guard (elName e == nsName "api") + let es1 = children e + p <- pNode "query" es1 + let es = children p + wl <- pNode "watchlist" es >>= xmlWatchList + let cont = pNode "query-continue" es1 >>= xmlContinue "watchlist" "wlstart" + return emptyWatchListResponse{wlWatch=wl,wlContinue=cont} + +xmlWatchList :: Element -> Maybe WatchList +xmlWatchList e = do + guard (elName e == nsName "watchlist") + let ns = fromMaybe "0" $ pAttr "ns" e + let tit = fromMaybe "" $ pAttr "title" e + let pid = pAttr "pageid" e + let rid = pAttr "revid" e + let usr = pAttr "user" e + let isa = isJust (pAttr "anon" e) + let isn = isJust (pAttr "new" e) + let ism = isJust (pAttr "minor" e) + let isp = isJust (pAttr "patrolled" e) + let ts = pAttr "timestamp" e + let len = pAttr "newlen" e >>= readMb + let leno = pAttr "oldlen" e >>= readMb + let co = pAttr "comment" e + let pg = emptyPageTitle{pgNS=ns,pgTitle=tit,pgMbId=pid} + return emptyWatchList + { wlPage = pg + , wlRevId = rid + , wlUser = usr + , wlIsAnon = isa + , wlIsNew = isn + , wlIsMinor = ism + , wlIsPatrolled = isp + , wlTimestamp = ts + , wlLength = len + , wlOldLength = leno + , wlComment = co + } + diff --git a/MediaWiki/API/Types.hs b/MediaWiki/API/Types.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Types.hs @@ -0,0 +1,241 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Types +-- Description : Basic MediaWiki API types +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- Basic MediaWiki API types +-- +-------------------------------------------------------------------- +module MediaWiki.API.Types where + +-- base types +type UserName = String +type NamespaceID = String +type TimeString = String +data Direction = Up | Down deriving ( Eq ) +type RevID = String +type PageName = String +type UserID = String +data TimeArrow = Earlier | Later deriving ( Eq ) +type Timestamp = String +type Redirect = String +type SortKind = String +type CatName = String +type GroupName = String +type FilterLang = String +type WithRedirects = String +type URLString = String +type Token = String +type LangName = String + +nullRevId :: RevID +nullRevId = "0" + +nullTimestamp :: Timestamp +nullTimestamp = "" + +nullUser :: UserName +nullUser = "" + +data PageTitle + = PageTitle { pgNS :: NamespaceID + , pgTitle :: Title + , pgMbId :: Maybe PageID + , pgMissing :: Bool + } + +emptyPageTitle :: PageTitle +emptyPageTitle + = PageTitle { pgNS = mainNamespace + , pgTitle = "" + , pgMbId = Nothing + , pgMissing = False + } + +mainNamespace :: NamespaceID +mainNamespace = "0" + +ns_MAIN :: NamespaceID +ns_MAIN = mainNamespace + +ns_IMAGE :: NamespaceID +ns_IMAGE = "6" + +data Format + = Format + { formatKind :: FormatKind + , formatFormatted :: Bool + } + +emptyFormat :: Format +emptyFormat = Format{formatKind=FormatXML, formatFormatted=True} + +xmlFormat :: Format +xmlFormat = emptyFormat{formatKind=FormatXML, formatFormatted=False} + +data FormatKind + = FormatJSON + | FormatPHP + | FormatWDDX + | FormatXML + | FormatYAML + | FormatTxt + | FormatDbg + +type User = String +type Password = String +type LoginToken = String +type SessionID = String +type SessionToken = String +type ValueName = (String,String) + +data UserInfo + = UserInfo + { uiName :: UserName + , uiId :: UserID + , uiIsAnon :: Bool + , uiHasMessage :: Bool + , uiBlocked :: Maybe (UserName,String) + , uiGroups :: [String] + , uiRights :: [String] + , uiOptions :: [(String,String)] + , uiRateLimits :: [RateLimit] + , uiEditCount :: Maybe Int + } + +emptyUserInfo :: UserInfo +emptyUserInfo = UserInfo + { uiName = nullUser + , uiId = "0" + , uiIsAnon = True + , uiHasMessage = False + , uiBlocked = Nothing + , uiGroups = [] + , uiRights = [] + , uiOptions = [] + , uiRateLimits = [] + , uiEditCount = Nothing + } + +data RateLimit + = RateLimit + { rlName :: String + , rlHits :: Int + , rlSeconds :: Int + } + + +data NamespaceInfo + = NamespaceInfo + { nsId :: String + , nsTitle :: String + , nsSubpages :: Bool + } + +data InterwikiEntry + = InterwikiEntry + { iwPrefix :: String + , iwLocal :: Bool + , iwTranscludable :: Maybe Bool + , iwUrl :: String + , iwLanguage :: Maybe String + } + +data UserSession + = UserSession + { sessUserId :: UserID + , sessUserName :: UserName + , sessPassword :: Maybe Password -- not sure; could leave out. + , sessCookiePrefix :: Maybe String + , sessSessionId :: Maybe SessionID + , sessToken :: LoginToken + } + +data HelpRequest + = HelpRequest + { helpVersion :: Maybe Bool + } + +type Title = String -- Q: what kind of encoding/escaping can be assumed here? +type PageID = String -- numeric ID, so arguably wrong Haskell type. +type RevisionID = String -- ditto. + +newtype PropKind + = PropKind { prKind :: String } + {- Not deemed worthy to try to enumerate them all. + -- Three major reasons: + -- - supportd properties are likely to evolve with MW API. + -- - fields support subsets of the type, so using a union type + -- for these is imprecise. + -- - development of queries are driven by reading the API documentation + -- from the MW API help page, so transliterations ought to be + -- accommodated. + -- - being too lazy to write them out is not a reason; did + -- have such an enum type defined at one point :-) + -} + +newtype MetaKind + = MetaKind { meKind :: String } -- likely values: siteinfo, userinfo, allmessages + +newtype ListKind + = ListKind { liKind :: String } + +newtype GeneratorKind + = GeneratorKind { genKind :: String } + +class APIRequest a where + showReq :: a -> [Maybe (String,String)] + isPostable :: a -> Bool + isPostable _ = False + + queryKind :: a -> QueryKind + queryKind _ = QProp "" + + +data QueryKind + = QProp String | QMeta String | QList String | QGen String + deriving ( Eq ) + +data QueryRequest + = QueryRequest + { quTitles :: [Title] + , quPageIds :: [PageID] + , quRevIds :: [RevisionID] + , quProps :: [PropKind] + , quLists :: [ListKind] + , quMetas :: [MetaKind] + , quGenerator :: Maybe GeneratorKind + , quFollowRedirects :: Maybe Bool + , quIndexPageIds :: Maybe Bool + } + +emptyQuery :: QueryRequest +emptyQuery = QueryRequest + { quTitles = [] + , quPageIds = [] + , quRevIds = [] + , quProps = [] + , quLists = [] + , quMetas = [] + , quGenerator = Nothing + , quFollowRedirects = Nothing + , quIndexPageIds = Nothing + } +{- +data MetaKindProp + = SiteInfoProp + | UserInfoProp + | AllMessagesProp + | ExpandTemplatesProp + | ParseProp + | OpenSearchProp + | FeedWatchlistProp + | HelpProp + | ParamInfoProp + -} diff --git a/MediaWiki/API/Utils.hs b/MediaWiki/API/Utils.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/API/Utils.hs @@ -0,0 +1,94 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.API.Utils +-- Description : MediaWiki API internal utility functions. +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: portable +-- +-- MediaWiki API internal utility functions. +-- +-------------------------------------------------------------------- +module MediaWiki.API.Utils + ( module MediaWiki.API.Utils + , fromMaybe + ) where + +import Text.XML.Light as XML +import Data.Maybe +import Data.List +import Control.Monad + +import MediaWiki.Util.Codec.URLEncoder ( encodeString ) + +pNodes :: String -> [XML.Element] -> [XML.Element] +pNodes x es = filter ((nsName x ==) . elName) es + +pNode :: String -> [XML.Element] -> Maybe XML.Element +pNode x es = listToMaybe (pNodes x es) + +pLeaf :: String -> [XML.Element] -> Maybe String +pLeaf x es = strContent `fmap` pNode x es + +pAttr :: String -> XML.Element -> Maybe String +pAttr x e = lookup (nsName x) [ (k,v) | Attr k v <- elAttribs e ] + +pMany :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a] +pMany p f es = mapMaybe f (pNodes p es) + +children :: XML.Element -> [XML.Element] +children e = onlyElems (elContent e) + +nsName :: String -> QName +nsName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing} + +without :: [String] -> [XML.Attr] -> [XML.Attr] +without xs as = filter (\ a -> not (attrKey a `elem` qxs)) as + where + qxs = map nsName xs + +parseDoc :: (Element -> Maybe a) -> String -> Either (String,[{-error msg-}String]) a +parseDoc f s = + case parseXMLDoc s of + Nothing -> Left (s, ["not valid XML content"]) + Just d -> + case f d of + Nothing -> Left (s,["unexpected XML response"]) + Just x -> Right x + +xmlContinue :: String -> String -> Element -> Maybe String +xmlContinue tgName atName e = do + guard (elName e == nsName "query-continue") + let es1 = children e + p <- pNode tgName es1 + pAttr atName p + +mbDef :: a -> Maybe a -> Maybe a +mbDef x Nothing = Just x +mbDef _ v = v + +readMb :: Read a => String -> Maybe a +readMb x = case reads x of + ((v,_):_) -> Just v + _ -> Nothing + +piped :: [String] -> String +piped xs = intercalate "|" xs + +opt :: String -> String -> Maybe (String,String) +opt a b = Just (a, encodeString b) + +optB :: String -> Bool -> Maybe (String,String) +optB _ False = Nothing +optB a _ = Just (a,"") + +opt1 :: String -> [String] -> Maybe (String,String) +opt1 _ [] = Nothing +opt1 a b = Just (a,encodeString $ piped b) + +mbOpt :: String -> (a -> String) -> Maybe a -> Maybe (String,String) +mbOpt _ _ Nothing = Nothing +mbOpt tg f (Just x) = Just (tg,encodeString $ f x) diff --git a/MediaWiki/Util/Codec/Percent.hs b/MediaWiki/Util/Codec/Percent.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/Util/Codec/Percent.hs @@ -0,0 +1,59 @@ +{- | + + Module : MediaWiki.Util.Codec.Percent + Copyright : (c) 2008 + + Maintainer : sof@forkIO.com + + License : See the file LICENSE + + Status : Coded + Stability : provisional + portability : portable + + Codec for de/encoding URI strings via percent encodings + (cf. RFC 3986.) +-} +module MediaWiki.Util.Codec.Percent where + +import Data.Char ( chr, isAlphaNum ) +import Numeric ( readHex, showHex ) + +getEncodedString :: String -> String +getEncodedString "" = "" +getEncodedString (x:xs) = + case getEncodedChar x of + Nothing -> x : getEncodedString xs + Just ss -> ss ++ getEncodedString xs + +getDecodedString :: String -> String +getDecodedString "" = "" +getDecodedString ls@(x:xs) = + case getDecodedChar ls of + Nothing -> x : getDecodedString xs + Just (ch,xs1) -> ch : getDecodedString xs1 + +getEncodedChar :: Char -> Maybe String +getEncodedChar x + | isAlphaNum x || + x `elem` "-_.~" = Nothing + | xi < 0xff = Just ('%':showHex (xi `div` 16) (showHex (xi `mod` 16) "")) + | otherwise = -- ToDo: import utf8 lib + error "getEncodedChar: can only handle 8-bit chars right now." + where + xi :: Int + xi = fromEnum x + +getDecodedChar :: String -> Maybe (Char, String) +getDecodedChar str = + case str of + "" -> Nothing + (x:xs) + | x /= '%' -> Nothing + | otherwise -> do + case xs of + (b1:b2:bs) -> + case readHex [b1,b2] of + ((v,_):_) -> Just (Data.Char.chr v, bs) + _ -> Nothing + _ -> Nothing diff --git a/MediaWiki/Util/Codec/URLEncoder.hs b/MediaWiki/Util/Codec/URLEncoder.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/Util/Codec/URLEncoder.hs @@ -0,0 +1,33 @@ +{- + Codec for de/encoding form data shipped in URL query strings + or in POST request bodies. (application/x-www-form-urlencoded) + (cf. RFC 3986.) +-} +module MediaWiki.Util.Codec.URLEncoder + ( encodeString + , decodeString + ) where + +import qualified Codec.Binary.UTF8.String as UTF8 ( encodeString ) +import MediaWiki.Util.Codec.Percent ( getEncodedChar, getDecodedChar ) + +encodeString :: String -> String +encodeString str = go (UTF8.encodeString str) + where + go "" = "" + go (' ':xs) = '+':go xs + go ('\r':'\n':xs) = '%':'0':'D':'%':'0':'A':go xs + go ('\r':xs) = go ('\r':'\n':xs) + go ('\n':xs) = go ('\r':'\n':xs) + go (x:xs) = + case getEncodedChar x of + Nothing -> x : go xs + Just ss -> ss ++ go xs + +decodeString :: String -> String +decodeString "" = "" +decodeString ('+':xs) = ' ':decodeString xs +decodeString ls@(x:xs) = + case getDecodedChar ls of + Nothing -> x : decodeString xs + Just (ch,xs1) -> ch : decodeString xs1 diff --git a/MediaWiki/Util/Fetch.hs b/MediaWiki/Util/Fetch.hs new file mode 100644 --- /dev/null +++ b/MediaWiki/Util/Fetch.hs @@ -0,0 +1,136 @@ +-------------------------------------------------------------------- +-- | +-- Module : MediaWiki.Util.Fetch +-- Copyright : (c) Sigbjorn Finne, 2008 +-- License : BSD3 +-- +-- Maintainer: Sigbjorn Finne +-- Stability : provisional +-- Portability: so-so +-- +-- Simple GET\/de-ref of URLs; abstracting out networking backend\/package. +-- +module MediaWiki.Util.Fetch + ( readContentsURL + , readUserContentsURL + + , postContentsURL + +-- , URLString + , User(..) + ) where + +--import Network.Curl +import Network.Browser +import Network.HTTP +import Network.URI + +type URLString = String + +data User + = User { userName :: String + , userPass :: String + } + +readContentsURL :: URLString -> IO String +readContentsURL u = do + req <- + case parseURI u of + Nothing -> fail ("ill-formed URL: " ++ u) + Just ur -> return (defaultGETRequest ur) + -- don't like doing this, but HTTP is awfully chatty re: cookie handling.. + let nullHandler _ = return () + (_u, resp) <- browse $ setOutHandler nullHandler >> request req + case rspCode resp of + (2,_,_) -> return (rspBody resp) + _ -> fail ("Failed reading URL " ++ show u ++ " code: " ++ show (rspCode resp)) + +{- Curl version: +readContentsURL :: URLString -> IO String +readContentsURL u = do + let opts = [ CurlFollowLocation True + ] + (_,xs) <- curlGetString u opts + return xs +-} + +readUserContentsURL :: User -> URLString -> IO String +readUserContentsURL usr us = do -- readContentsURL u + req <- + case parseURI us of + Nothing -> fail ("ill-formed URL: " ++ us) + Just ur -> return (defaultGETRequest ur) + -- don't like doing this, but HTTP is awfully chatty re: cookie handling.. + let nullHandler _ = return () + (u, resp) <- browse $ do + setOutHandler nullHandler + setAllowBasicAuth True + setAuthorityGen (\ _ _ -> return (Just (userName usr,userPass usr))) +{- + addAuthority AuthBasic{ auUsername = userName usr + , auPassword = userPass usr + , auRealm = "" + , auSite = nullURI{uriPath="/"} + } +-} + request req + case rspCode resp of + (2,_,_) -> return (rspBody resp) + _ -> fail ("Failed reading URL " ++ show u ++ " code: " ++ show (rspCode resp)) + + +postContentsURL :: Maybe User -> URLString -> [(String,String)] -> String -> IO ([(String,String)], String) +postContentsURL mbU u hdrs body = do + let hs = + case parseHeaders $ map (\ (x,y) -> x++": " ++ y) hdrs of + Left{} -> [] + Right xs -> xs + req0 <- + case parseURI u of + Nothing -> fail ("ill-formed URL: " ++ u) + Just ur -> return (defaultGETRequest ur) + let req = req0{rqMethod=POST + ,rqBody=body + ,rqHeaders=hs + } + let nullHandler _ = return () + (_,rsp) <- browse $ do + setOutHandler nullHandler + case mbU of + Nothing -> return () + Just usr -> do + setAllowBasicAuth True + setAuthorityGen (\ _ _ -> return (Just (userName usr,userPass usr))) + + request req + case rspCode rsp of + (2,_,_) -> return (map toP (rspHeaders rsp), rspBody rsp) + x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u) + where + toP (Header k v) = (show k, v) + +{- Curl versions: +readUserContentsURL :: User -> URLString -> IO String +readUserContentsURL u url = do + let opts = [ CurlHttpAuth [HttpAuthAny] + , CurlUserPwd (userName u ++ + case userPass u of {"" -> ""; p -> ':':p }) + , CurlFollowLocation True + ] + (_,xs) <- curlGetString url opts + return xs + +postContentsURL :: URLString -> [(String,String)] -> String -> IO String +postContentsURL u hdrs body = do + let opts = [ CurlCustomRequest "POST" + , CurlFollowLocation True + , CurlPost True + , CurlPostFields [body] + , CurlHttpTransferDecoding False + ] ++ [CurlHttpHeaders (map ( \ (x,y) -> (x ++ ':':y)) hdrs)] + rsp <- curlGetResponse u opts + case respStatus rsp `div` 100 of + 2 -> return (respBody rsp) + x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u) + +-} diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +module Main where + +import Distribution.Simple + + +main :: IO () +main = defaultMain diff --git a/examples/ListCat.hs b/examples/ListCat.hs new file mode 100644 --- /dev/null +++ b/examples/ListCat.hs @@ -0,0 +1,133 @@ +{- + Example of how to query for category members, demonstrating + the modules, types and steps used to interact with the API: + + foo$ listCat "Functional programming" + ... + foo$ +-} +module Main(main) where + +import MediaWiki.API.Base +import MediaWiki.API.Types ( PageTitle(..) ) +import MediaWiki.API +import MediaWiki.API.Query.CategoryMembers as CatMem +import MediaWiki.API.Query.CategoryMembers.Import as CatMem + +import Util.GetOpts +import System.IO +import System.Environment +import System.Exit + +import Control.Monad +--import Data.Maybe ( fromMaybe ) +import Data.List + +-- begin option handling +data Options + = Options + { optWiki :: String + , optUser :: Maybe String + , optPass :: Maybe String + , optCat :: Maybe String + } + +nullOptions :: Options +nullOptions = Options + { optWiki = "http://en.wikipedia.org/w/" + , optUser = Nothing + , optPass = Nothing + , optCat = Nothing + } + +option_descr :: [OptDescr (Options -> Options)] +option_descr = + [ Option ['u'] ["user"] + (ReqArg (\ x o -> o{optUser=Just x}) "USER") + "Wiki user name to login as" + , Option ['p'] ["pass"] + (ReqArg (\ x o -> o{optPass=Just x}) "PASSWORD") + "user's password credentials to supply if logging in" + , Option ['w'] ["wiki"] + (ReqArg (\ x o -> o{optWiki=x}) "WIKI") + "the Wiki to access" + , Option ['c'] ["cat"] + (ReqArg (\ x o -> o{optCat=Just x}) "CAT") + "the Wiki category to query for" + ] + + +parseOptions :: [String] -> (Options, [String], [String]) +parseOptions argv = getOpt2 Permute option_descr argv nullOptions + +processOptions :: IO (Options, [String]) +processOptions = do + ls <- getArgs + let (opts, ws, es) = parseOptions ls + when (not $ null es) $ do + hPutStrLn stderr (unlines es) + hPutStrLn stderr ("(try '--help' for list of options supported.)") + exitFailure + return (opts, ws) + +-- end option handling + +queryCat :: URLString -> String -> IO [PageTitle] +queryCat url catName = queryCat' url catName' req [] + where + catName' + | "Category:" `isPrefixOf` catName = wikify catName + | otherwise = "Category:"++wikify catName + + req = categoryMembersRequest{cmTitle=Just catName'} + + wikify "" = "" + wikify (' ':xs) = '_':wikify xs + wikify (x:xs) = x : wikify xs + + +queryCat' :: URLString -> String -> CategoryMembersRequest -> [PageTitle] -> IO [PageTitle] +queryCat' url catName cReq acc = do + let req = emptyXmlRequest (mkQueryAction (queryPage catName) cReq) + mb <- webGetXml CatMem.stringXml url req + case mb of + Nothing -> fail ("Failed to fetch pages for category " ++ catName ++ " from " ++ url) + Just c -> do + let acc' = (acc ++ cmPages c) + case cmContinue c of + Nothing -> return acc' + Just x -> queryCat' url catName cReq{cmContinueFrom=Just x} acc' + +main :: IO () +main = do + (opts, fs) <- processOptions + let url = optWiki opts + -- not needed here, but left in to show how to login to a Wiki. + case (optUser opts, optPass opts) of + (Just u, Just p) -> do + x <- loginWiki url u p + case x of + Nothing -> putStrLn ("Unable to login to: " ++ url) + Just lg -> print (lgSuccess lg) + _ -> return () + case mbCons (optCat opts) fs of + [] -> putStrLn "No categories specified!" + xs -> mapM_ (showCat url) xs + +showCat :: URLString -> String -> IO () +showCat url cat = do + ps <- queryCat url cat + putStrLn ("Members of category `" ++ cat ++ "'") + mapM_ (putStrLn.toTitle) ps + where + toTitle pg = ' ':pgTitle pg +{- NS prefix seems to be included in title.. + case pgNS pg of + "" -> pgTitle pg + xs -> xs ++ ':':pgTitle pg +-} + +mbCons :: Maybe a -> [a] -> [a] +mbCons Nothing xs = xs +mbCons (Just x) xs = x:xs + diff --git a/mediawiki.cabal b/mediawiki.cabal new file mode 100644 --- /dev/null +++ b/mediawiki.cabal @@ -0,0 +1,123 @@ +Name: mediawiki +Version: 0.2 +License: BSD3 +License-file: LICENSE +Category: Web +Synopsis: Interfacing with the MediaWiki API +Description: A complete Haskell binding to the MediaWiki API +Author: Sigbjorn Finne +Maintainer: Sigbjorn Finne +Cabal-version: >= 1.2 +build-type: Simple + +flag new-base + description: Build with new smaller base library + default: False + +library + Exposed-Modules: MediaWiki.API.Types, + MediaWiki.API.Output, + MediaWiki.API, + MediaWiki.API.Base, + MediaWiki.API.Utils, + MediaWiki.API.Query.AllCategories, + MediaWiki.API.Query.AllCategories.Import, + MediaWiki.API.Query.AllImages, + MediaWiki.API.Query.AllImages.Import, + MediaWiki.API.Query.AllLinks, + MediaWiki.API.Query.AllLinks.Import, + MediaWiki.API.Query.AllMessages, + MediaWiki.API.Query.AllMessages.Import, + MediaWiki.API.Query.AllPages, + MediaWiki.API.Query.AllPages.Import, + MediaWiki.API.Query.AllUsers, + MediaWiki.API.Query.AllUsers.Import, + MediaWiki.API.Query.BackLinks, + MediaWiki.API.Query.BackLinks.Import, + MediaWiki.API.Query.Blocks, + MediaWiki.API.Query.Blocks.Import, + MediaWiki.API.Query.Categories, + MediaWiki.API.Query.Categories.Import, + MediaWiki.API.Query.CategoryInfo, + MediaWiki.API.Query.CategoryInfo.Import, + MediaWiki.API.Query.CategoryMembers, + MediaWiki.API.Query.CategoryMembers.Import, + MediaWiki.API.Query.DeletedRevisions, + MediaWiki.API.Query.DeletedRevisions.Import, + MediaWiki.API.Query.EmbeddedIn, + MediaWiki.API.Query.EmbeddedIn.Import, + MediaWiki.API.Query.ExternalLinks + MediaWiki.API.Query.ExternalLinks.Import, + MediaWiki.API.Query.ExternalURLUsage + MediaWiki.API.Query.ExternalURLUsage.Import, + MediaWiki.API.Query.ImageInfo, + MediaWiki.API.Query.ImageInfo.Import, + MediaWiki.API.Query.Images, + MediaWiki.API.Query.Images.Import, + MediaWiki.API.Query.ImageUsage, + MediaWiki.API.Query.ImageUsage.Import, + MediaWiki.API.Query.Info, + MediaWiki.API.Query.Info.Import, + MediaWiki.API.Query.LangLinks, + MediaWiki.API.Query.LangLinks.Import, + MediaWiki.API.Query.Links, + MediaWiki.API.Query.Links.Import, + MediaWiki.API.Query.LogEvents, + MediaWiki.API.Query.LogEvents.Import, + MediaWiki.API.Query.Random, + MediaWiki.API.Query.Random.Import, + MediaWiki.API.Query.RecentChanges, + MediaWiki.API.Query.RecentChanges.Import, + MediaWiki.API.Query.Revisions, + MediaWiki.API.Query.Revisions.Import, + MediaWiki.API.Query.Search, + MediaWiki.API.Query.Search.Import, + MediaWiki.API.Query.SiteInfo, + MediaWiki.API.Query.SiteInfo.Import, + MediaWiki.API.Query.Templates, + MediaWiki.API.Query.Templates.Import, + MediaWiki.API.Query.UserContribs, + MediaWiki.API.Query.UserContribs.Import, + MediaWiki.API.Query.UserInfo, + MediaWiki.API.Query.UserInfo.Import, + MediaWiki.API.Query.Users, + MediaWiki.API.Query.Users.Import, + MediaWiki.API.Query.WatchList, + MediaWiki.API.Query.WatchList.Import, + MediaWiki.API.Action.Sitematrix, + MediaWiki.API.Action.Login, + MediaWiki.API.Action.Login.Import, + MediaWiki.API.Action.ParamInfo, + MediaWiki.API.Action.Parse, + MediaWiki.API.Action.Parse.Import, + MediaWiki.API.Action.Rollback, + MediaWiki.API.Action.Delete, + MediaWiki.API.Action.Undelete, + MediaWiki.API.Action.Protect, + MediaWiki.API.Action.Block, + MediaWiki.API.Action.Unblock, + MediaWiki.API.Action.Move, + MediaWiki.API.Action.Edit, + MediaWiki.API.Action.EmailUser, + MediaWiki.API.Action.Watch, + MediaWiki.API.Action.OpenSearch, + MediaWiki.API.Action.FeedWatchlist, + MediaWiki.API.Action.ExpandTemplates, + MediaWiki.API.Action.ExpandTemplates.Import, + MediaWiki.Util.Fetch, + MediaWiki.Util.Codec.Percent, + MediaWiki.Util.Codec.URLEncoder + Ghc-Options: -Wall -O2 + Build-Depends: base, xml, HTTP, network, mime, utf8-string + +executable main { + build-depends: base + main-is: Main.hs + ghc-options: -Wall -fglasgow-exts +} + +executable listCat { + build-depends: base, pretty + main-is: examples/ListCat.hs + ghc-options: -Wall -fglasgow-exts -iexamples +}