diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,83 +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 +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 --- a/MediaWiki/API.hs +++ b/MediaWiki/API.hs @@ -11,9 +11,9 @@ -- Portability: portable -- -- A Haskell MediaWiki API binding. --- +-- -------------------------------------------------------------------- -module MediaWiki.API +module MediaWiki.API ( module MediaWiki.API , URLString ) where @@ -25,7 +25,6 @@ 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 @@ -52,8 +51,8 @@ webPost mbUser url act req = do let url_q = url ++ "api.php?action="++act let pload = showRequest req - (_cookiesOut, hs, p) <- - postContentsURL mbUser + (_cookiesOut, hs, p) <- + postContentsURL mbUser url_q [ ("Content-Length", show $ length pload) , ("Content-Type", showMIMEType form_mime_ty) @@ -76,7 +75,7 @@ "" -> return Nothing ls -> do case p ls of - Left (x,errs) -> + Left (x,errs) -> case parseError ls of Right e -> throwMWError e _ -> putStrLn (x ++ ':':' ':unlines errs) >> return Nothing @@ -89,7 +88,7 @@ webGetXml p url req = do ls <- webGet url req case p ls of - Left (x,errs) -> + Left (x,errs) -> case parseError ls of Right e -> throwMWError e _ -> putStrLn (x ++ ':':' ':unlines errs) >> return Nothing @@ -99,14 +98,14 @@ queryPage pg = emptyQuery{quTitles=[pg]} mkQueryAction :: APIRequest a => QueryRequest -> a -> Action -mkQueryAction q qr = +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@ logs in to MediaWiki install at @url@ as +-- | @loginWiki u usr pass@ logs in to MediaWiki install at @url@ as -- user @usr@ with password credentials @pass@. Notice that we don't -- presently allow HTTP Auth to happen in conjunction with the Wiki -- login. @@ -121,10 +120,10 @@ req = emptyXmlRequest (mkQueryAction (queryPage pgName) infoRequest) querySiteIWInfo :: URLString -> IO (Maybe SiteInfoResponse) -querySiteIWInfo url = webGetXml SI.stringXml url req +querySiteIWInfo url = webGetXml SI.stringXml url req where - req = emptyXmlRequest - (mkQueryAction (queryPage "XP") + req = emptyXmlRequest + (mkQueryAction (queryPage "XP") siteInfoRequest{siProp=["interwikimap"]}) queryLangPage :: URLString -> PageName -> Maybe String -> IO String @@ -158,22 +157,21 @@ mwError :: MediaWikiError mwError = MediaWikiError{mwErrorCode="",mwErrorInfo=""} -#if defined(EXTENSIBLE_EXCEPTIONS) -data SomeMWException = forall e . Exception e => SomeMWException e - deriving Typeable +data SomeMWException = forall e . Exception e => SomeMWException e + deriving Typeable -instance Show SomeMWException where - show (SomeMWException e) = show e +instance Show SomeMWException where + show (SomeMWException e) = show e -instance Exception SomeMWException +instance Exception SomeMWException mwToException :: Exception e => e -> SomeException -mwToException = toException . SomeMWException +mwToException = toException . SomeMWException -mwFromException :: Exception e => SomeException -> Maybe e -mwFromException x = do - SomeMWException a <- fromException x - cast a +mwFromException :: Exception e => SomeException -> Maybe e +mwFromException x = do + SomeMWException a <- fromException x + cast a instance Exception MediaWikiError where toException = mwToException @@ -183,18 +181,9 @@ throwMWError e = throwIO e catchMW :: IO a -> (MediaWikiError -> IO a) -> IO a -catchMW f hdlr = - CE.catch f - (\ e1 -> hdlr e1) -#else -throwMWError :: MediaWikiError -> IO a -throwMWError mw = throwDyn mw - -catchMW :: IO a -> (MediaWikiError -> IO a) -> IO a catchMW f hdlr = - CE.catchDyn f + CE.catch f (\ e1 -> hdlr e1) -#endif handleMW :: (MediaWikiError -> IO a) -> IO a -> IO a handleMW h e = catchMW e h diff --git a/MediaWiki/API/Action/ExpandTemplates.hs b/MediaWiki/API/Action/ExpandTemplates.hs --- a/MediaWiki/API/Action/ExpandTemplates.hs +++ b/MediaWiki/API/Action/ExpandTemplates.hs @@ -1,44 +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 - } - +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Action/ExpandTemplates/Import.hs +++ b/MediaWiki/API/Action/ExpandTemplates/Import.hs @@ -10,7 +10,7 @@ -- Portability: portable -- -- Serializing ExpandTemplates requests. --- +-- -------------------------------------------------------------------- module MediaWiki.API.Action.ExpandTemplates.Import where @@ -22,7 +22,6 @@ 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 diff --git a/MediaWiki/API/Action/FeedWatchlist.hs b/MediaWiki/API/Action/FeedWatchlist.hs --- a/MediaWiki/API/Action/FeedWatchlist.hs +++ b/MediaWiki/API/Action/FeedWatchlist.hs @@ -1,49 +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 - } - +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Action/Login.hs +++ b/MediaWiki/API/Action/Login.hs @@ -1,67 +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 - } - +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Action/Login/Import.hs +++ b/MediaWiki/API/Action/Login/Import.hs @@ -10,7 +10,7 @@ -- Portability: portable -- -- Serializing Login requests. --- +-- -------------------------------------------------------------------- module MediaWiki.API.Action.Login.Import where @@ -21,7 +21,6 @@ import Text.XML.Light.Types import Control.Monad -import Data.Maybe stringXml :: String -> Either (String,[{-Error msg-}String]) LoginResponse stringXml s = parseDoc xml s @@ -39,7 +38,7 @@ let ses = pAttr "sessionid" p case res of Nothing -> fail "missing 'result' api attribute" - Just "Success" -> + Just "Success" -> return LoginResponse{ lgSuccess=True , lgSession=UserSession { sessUserId = fromMaybe "" uid @@ -58,4 +57,4 @@ , lgeDetails = det , lgeWait = fromMaybe "" wai } - + diff --git a/MediaWiki/API/Action/OpenSearch.hs b/MediaWiki/API/Action/OpenSearch.hs --- a/MediaWiki/API/Action/OpenSearch.hs +++ b/MediaWiki/API/Action/OpenSearch.hs @@ -1,44 +1,42 @@ --------------------------------------------------------------------- --- | --- 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] - } - +-------------------------------------------------------------------- +-- | +-- 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 + +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 --- a/MediaWiki/API/Action/ParamInfo.hs +++ b/MediaWiki/API/Action/ParamInfo.hs @@ -1,59 +1,57 @@ --------------------------------------------------------------------- --- | --- 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] +-------------------------------------------------------------------- +-- | +-- 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 + +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 --- a/MediaWiki/API/Action/Parse.hs +++ b/MediaWiki/API/Action/Parse.hs @@ -1,89 +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 - } - +-------------------------------------------------------------------- +-- | +-- 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/Sitematrix.hs b/MediaWiki/API/Action/Sitematrix.hs --- a/MediaWiki/API/Action/Sitematrix.hs +++ b/MediaWiki/API/Action/Sitematrix.hs @@ -1,48 +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 } +-------------------------------------------------------------------- +-- | +-- 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/Base.hs b/MediaWiki/API/Base.hs --- a/MediaWiki/API/Base.hs +++ b/MediaWiki/API/Base.hs @@ -1,329 +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 - +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Output.hs +++ b/MediaWiki/API/Output.hs @@ -1,212 +1,212 @@ --------------------------------------------------------------------- --- | --- 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 MediaWiki.Util.Codec.Percent - -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 - [ fList "titles" (quTitles q) - , fList "pageids" (quPageIds q) - , fList "revids" (quRevIds q) - , fList "prop" (map showPropKind $ quProps q) - , fList "list" (map showListKind $ quLists q) - , fList "meta" (map showMetaKind $ quMetas q) - , fieldMb "generator" showGeneratorKind (quGenerator q) - , fieldMb "redirects" showBool (quFollowRedirects q) - , fieldMb "indexpageids" showBool (quIndexPageIds q) - ] - where - fList t ls = fieldList t "|" ls - -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 (intercalate (getEncodedString s) xs)) - - +-------------------------------------------------------------------- +-- | +-- 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 MediaWiki.Util.Codec.Percent + +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 + [ fList "titles" (quTitles q) + , fList "pageids" (quPageIds q) + , fList "revids" (quRevIds q) + , fList "prop" (map showPropKind $ quProps q) + , fList "list" (map showListKind $ quLists q) + , fList "meta" (map showMetaKind $ quMetas q) + , fieldMb "generator" showGeneratorKind (quGenerator q) + , fieldMb "redirects" showBool (quFollowRedirects q) + , fieldMb "indexpageids" showBool (quIndexPageIds q) + ] + where + fList t ls = fieldList t "|" ls + +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 (intercalate (getEncodedString s) xs)) + + diff --git a/MediaWiki/API/Query/AllImages/Import.hs b/MediaWiki/API/Query/AllImages/Import.hs --- a/MediaWiki/API/Query/AllImages/Import.hs +++ b/MediaWiki/API/Query/AllImages/Import.hs @@ -1,12 +1,10 @@ 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 diff --git a/MediaWiki/API/Query/AllPages/Import.hs b/MediaWiki/API/Query/AllPages/Import.hs --- a/MediaWiki/API/Query/AllPages/Import.hs +++ b/MediaWiki/API/Query/AllPages/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.AllPages import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/AllUsers/Import.hs b/MediaWiki/API/Query/AllUsers/Import.hs --- a/MediaWiki/API/Query/AllUsers/Import.hs +++ b/MediaWiki/API/Query/AllUsers/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.AllUsers import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/Blocks/Import.hs b/MediaWiki/API/Query/Blocks/Import.hs --- a/MediaWiki/API/Query/Blocks/Import.hs +++ b/MediaWiki/API/Query/Blocks/Import.hs @@ -1,11 +1,9 @@ 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 diff --git a/MediaWiki/API/Query/Categories/Import.hs b/MediaWiki/API/Query/Categories/Import.hs --- a/MediaWiki/API/Query/Categories/Import.hs +++ b/MediaWiki/API/Query/Categories/Import.hs @@ -16,8 +16,8 @@ xml e = do guard (elName e == nsName "api") let es1 = children e - p <- pNode "query" es1 - let es2 = children p + q <- pNode "query" es1 + let es2 = children q p <- pNode "pages" es2 let ps0 = pNodes "page" $ children p let ps1 = catMaybes (map xmlPage ps0) @@ -32,7 +32,7 @@ -- depending on being 'prop'-constrained, a 'page' -- may have a 'categories' child. (Or the page may not belong -- to a category at all, I suppose..) - let cs = + let cs = maybe [] (\ c -> catMaybes (map xmlCL (pNodes "cl" $ children c))) (pNode "categories" es) diff --git a/MediaWiki/API/Query/CategoryMembers/Import.hs b/MediaWiki/API/Query/CategoryMembers/Import.hs --- a/MediaWiki/API/Query/CategoryMembers/Import.hs +++ b/MediaWiki/API/Query/CategoryMembers/Import.hs @@ -28,5 +28,4 @@ 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} + return emptyPageTitle{pgNS = ns,pgTitle = tit,pgMbId = mbpid} diff --git a/MediaWiki/API/Query/ExternalURLUsage/Import.hs b/MediaWiki/API/Query/ExternalURLUsage/Import.hs --- a/MediaWiki/API/Query/ExternalURLUsage/Import.hs +++ b/MediaWiki/API/Query/ExternalURLUsage/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.ExternalURLUsage import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/ImageInfo/Import.hs b/MediaWiki/API/Query/ImageInfo/Import.hs --- a/MediaWiki/API/Query/ImageInfo/Import.hs +++ b/MediaWiki/API/Query/ImageInfo/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.ImageInfo import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe @@ -39,7 +38,7 @@ xmlII :: String -> Element -> Maybe ImageInfo xmlII tg p = do - guard (elName p == nsName tg) + 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 @@ -65,11 +64,11 @@ , iiMime = mi } - + readI :: String -> Maybe Int -readI s = +readI s = case reads s of ((v,_):_) -> Just v _ -> Nothing - + diff --git a/MediaWiki/API/Query/Info.hs b/MediaWiki/API/Query/Info.hs --- a/MediaWiki/API/Query/Info.hs +++ b/MediaWiki/API/Query/Info.hs @@ -1,90 +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 - } +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Query/Info/Import.hs +++ b/MediaWiki/API/Query/Info/Import.hs @@ -1,54 +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 = [] - } +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/Links.hs b/MediaWiki/API/Query/Links.hs --- a/MediaWiki/API/Query/Links.hs +++ b/MediaWiki/API/Query/Links.hs @@ -1,55 +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 - } - +-------------------------------------------------------------------- +-- | +-- 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/Random/Import.hs b/MediaWiki/API/Query/Random/Import.hs --- a/MediaWiki/API/Query/Random/Import.hs +++ b/MediaWiki/API/Query/Random/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.Random import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/RecentChanges/Import.hs b/MediaWiki/API/Query/RecentChanges/Import.hs --- a/MediaWiki/API/Query/RecentChanges/Import.hs +++ b/MediaWiki/API/Query/RecentChanges/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.RecentChanges import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe @@ -36,8 +35,8 @@ 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] + let pg_to + | any isJust [ns_t,tit_t,pid_t] = Just emptyPageTitle{ pgNS=fromMaybe mainNamespace ns_t , pgTitle=fromMaybe "" tit_t @@ -73,8 +72,3 @@ , rchTimestamp = ts , rchComment = co } - - - - - diff --git a/MediaWiki/API/Query/Revisions.hs b/MediaWiki/API/Query/Revisions.hs --- a/MediaWiki/API/Query/Revisions.hs +++ b/MediaWiki/API/Query/Revisions.hs @@ -1,110 +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 - } +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Query/Revisions/Import.hs +++ b/MediaWiki/API/Query/Revisions/Import.hs @@ -5,8 +5,7 @@ import MediaWiki.API.Query.Revisions import Text.XML.Light.Types -import Text.XML.Light.Input ( parseXMLDoc ) -import Text.XML.Light.Proc ( strContent ) +import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe @@ -33,17 +32,17 @@ let ns = fromMaybe mainNamespace $ pAttr "ns" e let tit = fromMaybe "" $ pAttr "title" e let pid = pAttr "pageid" e - let es = children 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) + rs <- fmap (mapMaybe (xmlRevision pg)) (fmap children $ pNode "rev" (children p)) 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 mino = isJust (pAttr "minor" e) let usr = fromMaybe "" $ pAttr "user" e let anon = isJust (pAttr "anon" e) let ts = fromMaybe "" $ pAttr "timestamp" e @@ -52,7 +51,7 @@ let con = case strContent e of { "" -> Nothing ; xs -> Just xs} return (emptyRevision pg) { revRevId = rid - , revIsMinor = min + , revIsMinor = mino , revUser = usr , revIsAnon = anon , revTimestamp = ts diff --git a/MediaWiki/API/Query/Search/Import.hs b/MediaWiki/API/Query/Search/Import.hs --- a/MediaWiki/API/Query/Search/Import.hs +++ b/MediaWiki/API/Query/Search/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.Search import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/Templates/Import.hs b/MediaWiki/API/Query/Templates/Import.hs --- a/MediaWiki/API/Query/Templates/Import.hs +++ b/MediaWiki/API/Query/Templates/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.Templates import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe diff --git a/MediaWiki/API/Query/Users/Import.hs b/MediaWiki/API/Query/Users/Import.hs --- a/MediaWiki/API/Query/Users/Import.hs +++ b/MediaWiki/API/Query/Users/Import.hs @@ -1,6 +1,5 @@ module MediaWiki.API.Query.Users.Import where -import MediaWiki.API.Types import MediaWiki.API.Utils import MediaWiki.API.Query.Users @@ -43,5 +42,5 @@ xmlG p = do guard (elName p == nsName "g") return (strContent p) - + diff --git a/MediaWiki/API/Query/WatchList/Import.hs b/MediaWiki/API/Query/WatchList/Import.hs --- a/MediaWiki/API/Query/WatchList/Import.hs +++ b/MediaWiki/API/Query/WatchList/Import.hs @@ -5,7 +5,6 @@ import MediaWiki.API.Query.WatchList import Text.XML.Light.Types -import Text.XML.Light.Proc ( strContent ) import Control.Monad import Data.Maybe @@ -53,4 +52,4 @@ , wlOldLength = leno , wlComment = co } - + diff --git a/MediaWiki/API/Types.hs b/MediaWiki/API/Types.hs --- a/MediaWiki/API/Types.hs +++ b/MediaWiki/API/Types.hs @@ -1,241 +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 - -} +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/API/Utils.hs +++ b/MediaWiki/API/Utils.hs @@ -1,94 +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) +-------------------------------------------------------------------- +-- | +-- 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 --- a/MediaWiki/Util/Codec/Percent.hs +++ b/MediaWiki/Util/Codec/Percent.hs @@ -16,7 +16,7 @@ -} module MediaWiki.Util.Codec.Percent where -import Data.Char ( chr, isAlphaNum ) +import Data.Char ( chr, isAlphaNum, isAscii ) import Numeric ( readHex, showHex ) getEncodedString :: String -> String @@ -35,7 +35,7 @@ getEncodedChar :: Char -> Maybe String getEncodedChar x - | isAlphaNum x || + | (isAlphaNum x && isAscii x) || x `elem` "-_.~" = Nothing | xi < 0xff = Just ('%':showHex (xi `div` 16) (showHex (xi `mod` 16) "")) | otherwise = -- ToDo: import utf8 lib diff --git a/MediaWiki/Util/Fetch.hs b/MediaWiki/Util/Fetch.hs --- a/MediaWiki/Util/Fetch.hs +++ b/MediaWiki/Util/Fetch.hs @@ -1,182 +1,182 @@ --------------------------------------------------------------------- --- | --- 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 - , AuthUser(..) - , nullAuthUser - , Cookie - ) where - ---import Network.Curl -import Network.Browser -import Network.HTTP -import Network.URI - -type URLString = String - -data AuthUser - = AuthUser - { authUserName :: String - , authUserPass :: String - } - -nullAuthUser :: AuthUser -nullAuthUser = AuthUser - { authUserName = "" - , authUserPass = "" - } - -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 :: Maybe AuthUser -> Bool -> Bool -> URLString -> [(String,String)] -> IO ([(String,String)], String) -readUserContentsURL mbU doRedir isHead us hdrs = do -- readContentsURL u - let hs = - case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders 0 hdrs) of - Left{} -> [] - Right xs -> xs - req0 <- - 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 req = insertHeaderIfMissing HdrHost (authority (rqURI req0)) $ - req0{ rqMethod=if isHead then HEAD else GET - , rqHeaders= hs - , rqURI = (rqURI req0){uriScheme="",uriAuthority=Nothing} - } - let nullHandler _ = return () - (u, resp) <- browse $ do - setOutHandler nullHandler - case mbU of - Nothing -> return () - Just usr -> do - setAllowRedirects doRedir - setAllowBasicAuth True - setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) - --- setAllowBasicAuth True --- setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) -{- - addAuthority AuthBasic{ auUsername = userName usr - , auPassword = userPass usr - , auRealm = "" - , auSite = nullURI{uriPath="/"} - } --} - request req - case rspCode resp of - (2,_,_) -> return (map toP (rspHeaders resp), rspBody resp) - (3,_,_) | not doRedir -> return (map toP (rspHeaders resp), rspBody resp) - _ -> fail ("Failed reading URL " ++ show u ++ " code: " ++ show (rspCode resp)) - - -postContentsURL :: Maybe AuthUser - -> URLString - -> [(String,String)] - -> [Cookie] - -> String - -> IO ([Cookie],[(String,String)], String) -postContentsURL mbU u hdrs csIn body = do - let hs = - case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders (length body) hdrs) of - Left{} -> [] - Right xs -> xs - req0 <- - case parseURI u of - Nothing -> fail ("ill-formed URL: " ++ u) - Just ur -> return (defaultGETRequest ur) - let req = insertHeaderIfMissing HdrHost (authority (rqURI req0)) $ - req0{ rqMethod=POST - , rqBody=body - , rqHeaders= hs - , rqURI = (rqURI req0){uriScheme="",uriAuthority=Nothing} - } --- print req -- ,body) - let nullHandler _ = return () - ((_,rsp),cs) <- browse $ do - setOutHandler nullHandler - setAllowRedirects True - setCookies csIn - case mbU of - Nothing -> return () - Just usr -> do - setAllowBasicAuth True - setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) - - v <- request req - ls <- getCookies - return (v,ls) - case rspCode rsp of - (2,_,_) -> return (cs,map toP (rspHeaders rsp), rspBody rsp) - x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u ++ show (rspBody rsp)) - -toP :: Header -> (String, String) -toP (Header k v) = (show k, v) - -addDefaultHeaders :: Int -> [(String,String)] -> [(String,String)] -addDefaultHeaders clen hs = - addIfMiss "User-Agent" "hs-twitter" $ - addIfMiss "Content-Length" (show clen) hs - where - addIfMiss f v xs = maybe ((f,v):xs) (const xs) (lookup f xs) - -{- Curl versions: -readUserContentsURL :: User -> URLString -> IO String -readUserContentsURL u url = do - let opts = [ CurlHttpAuth [HttpAuthAny] - , CurlUserPwd (authUserName u ++ - case authUserPass 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) - --} +-------------------------------------------------------------------- +-- | +-- 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 + , AuthUser(..) + , nullAuthUser + , Cookie + ) where + +--import Network.Curl +import Network.Browser +import Network.HTTP +import Network.URI + +type URLString = String + +data AuthUser + = AuthUser + { authUserName :: String + , authUserPass :: String + } + +nullAuthUser :: AuthUser +nullAuthUser = AuthUser + { authUserName = "" + , authUserPass = "" + } + +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 :: Maybe AuthUser -> Bool -> Bool -> URLString -> [(String,String)] -> IO ([(String,String)], String) +readUserContentsURL mbU doRedir isHead us hdrs = do -- readContentsURL u + let hs = + case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders 0 hdrs) of + Left{} -> [] + Right xs -> xs + req0 <- + 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 req = insertHeaderIfMissing HdrHost (authority (rqURI req0)) $ + req0{ rqMethod=if isHead then HEAD else GET + , rqHeaders= hs + , rqURI = (rqURI req0){uriScheme="",uriAuthority=Nothing} + } + let nullHandler _ = return () + (u, resp) <- browse $ do + setOutHandler nullHandler + case mbU of + Nothing -> return () + Just usr -> do + setAllowRedirects doRedir + setAllowBasicAuth True + setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) + +-- setAllowBasicAuth True +-- setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) +{- + addAuthority AuthBasic{ auUsername = userName usr + , auPassword = userPass usr + , auRealm = "" + , auSite = nullURI{uriPath="/"} + } +-} + request req + case rspCode resp of + (2,_,_) -> return (map toP (rspHeaders resp), rspBody resp) + (3,_,_) | not doRedir -> return (map toP (rspHeaders resp), rspBody resp) + _ -> fail ("Failed reading URL " ++ show u ++ " code: " ++ show (rspCode resp)) + + +postContentsURL :: Maybe AuthUser + -> URLString + -> [(String,String)] + -> [Cookie] + -> String + -> IO ([Cookie],[(String,String)], String) +postContentsURL mbU u hdrs csIn body = do + let hs = + case parseHeaders $ map (\ (x,y) -> x++": " ++ y) (addDefaultHeaders (length body) hdrs) of + Left{} -> [] + Right xs -> xs + req0 <- + case parseURI u of + Nothing -> fail ("ill-formed URL: " ++ u) + Just ur -> return (defaultGETRequest ur) + let req = insertHeaderIfMissing HdrHost (authority (rqURI req0)) $ + req0{ rqMethod=POST + , rqBody=body + , rqHeaders= hs + , rqURI = (rqURI req0){uriScheme="",uriAuthority=Nothing} + } +-- print req -- ,body) + let nullHandler _ = return () + ((_,rsp),cs) <- browse $ do + setOutHandler nullHandler + setAllowRedirects True + setCookies csIn + case mbU of + Nothing -> return () + Just usr -> do + setAllowBasicAuth True + setAuthorityGen (\ _ _ -> return (Just (authUserName usr,authUserPass usr))) + + v <- request req + ls <- getCookies + return (v,ls) + case rspCode rsp of + (2,_,_) -> return (cs,map toP (rspHeaders rsp), rspBody rsp) + x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u ++ show (rspBody rsp)) + +toP :: Header -> (String, String) +toP (Header k v) = (show k, v) + +addDefaultHeaders :: Int -> [(String,String)] -> [(String,String)] +addDefaultHeaders clen hs = + addIfMiss "User-Agent" "hs-twitter" $ + addIfMiss "Content-Length" (show clen) hs + where + addIfMiss f v xs = maybe ((f,v):xs) (const xs) (lookup f xs) + +{- Curl versions: +readUserContentsURL :: User -> URLString -> IO String +readUserContentsURL u url = do + let opts = [ CurlHttpAuth [HttpAuthAny] + , CurlUserPwd (authUserName u ++ + case authUserPass 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 --- a/Setup.hs +++ b/Setup.hs @@ -1,7 +1,7 @@ -module Main where - -import Distribution.Simple - - -main :: IO () -main = defaultMain +module Main where + +import Distribution.Simple + + +main :: IO () +main = defaultMain diff --git a/examples/LinksTo.hs b/examples/LinksTo.hs new file mode 100644 --- /dev/null +++ b/examples/LinksTo.hs @@ -0,0 +1,85 @@ +{- + Querying for back/in links to a given page. + + foo$ path/to/linksTo "Haskell" + ... + foo$ +-} +module Main(main) where + +import MediaWiki.API.Base +import MediaWiki.API.Types ( PageTitle(..) ) +import MediaWiki.API + +import MediaWiki.API.Query.BackLinks.Import as Back + +import Util.GetOpts + +-- begin option handling +data Options + = Options + { optWiki :: String + , optUser :: Maybe String + , optPass :: Maybe String + , optPage :: Maybe String + } + +nullOptions :: Options +nullOptions = Options + { optWiki = "http://en.wikipedia.org/w/" + , optUser = Nothing + , optPass = Nothing + , optPage = 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 ['P'] ["page"] + (ReqArg (\ x o -> o{optPage=Just x}) "PAGE") + "the page title to list category pages for" + ] + +-- end option handling + +queryPageInLinks :: URLString -> String -> IO [PageTitle] +queryPageInLinks url pgName = queryInLinks emptyBackLinksRequest{blTitle=Just pgName} [] + where + queryInLinks bReq acc = do + let req = emptyXmlRequest (mkQueryAction (queryPage pgName) bReq) + mb <- webGetXml Back.stringXml url req + case mb of + Nothing -> fail ("Failed to fetch page" ++ pgName ++ " from " ++ url) + Just c -> do + let acc' = acc ++ blLinks c + case blContinue c of + Nothing -> return acc' + Just x -> queryInLinks bReq{blContinueFrom=Just x} acc' + +main :: IO () +main = do + (opts, fs) <- processOptions option_descr nullOptions + let url = optWiki opts + case mbCons (optPage opts) fs of + [] -> return () + xs -> mapM_ (linksToPage url) xs + +linksToPage :: URLString -> String -> IO () +linksToPage url pgName = do + ps <- queryPageInLinks url pgName + putStrLn ("Page " ++ show pgName ++ " has the following backlinks: ") + mapM_ (putStrLn.toTitle) ps + where + toTitle pg = ' ':pgTitle pg + +mbCons :: Maybe a -> [a] -> [a] +mbCons Nothing xs = xs +mbCons (Just x) xs = x:xs diff --git a/examples/ListCat.hs b/examples/ListCat.hs --- a/examples/ListCat.hs +++ b/examples/ListCat.hs @@ -1,161 +1,139 @@ -{- - 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 MediaWiki.API.Query.Categories as Cats -import MediaWiki.API.Query.Categories.Import as Cats - -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 - , optPage :: Maybe String - } - -nullOptions :: Options -nullOptions = Options - { optWiki = "http://en.wikipedia.org/w/" - , optUser = Nothing - , optPass = Nothing - , optCat = Nothing - , optPage = 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" - , Option ['P'] ["page"] - (ReqArg (\ x o -> o{optPage=Just x}) "PAGE") - "the page title to list category pages 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' - -queryPageCats :: URLString -> String -> IO [PageTitle] -queryPageCats url pgName = queryPageCats' emptyCategoriesRequest [] - where - queryPageCats' cReq acc = do - let req = emptyXmlRequest (mkQueryAction (queryPage pgName) cReq) - mb <- webGetXml Cats.stringXml url req - case mb of - Nothing -> fail ("Failed to fetch page" ++ pgName ++ " from " ++ url) - Just c -> do - let acc' = (acc ++ clPages c) - case clContinue c of - Nothing -> return (concatMap snd acc') - Just x -> queryPageCats' cReq{clContinueFrom=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 - case mbCons (optPage opts) fs of - [] -> return () - xs -> mapM_ (showPages 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 - -showPages :: URLString -> String -> IO () -showPages url pgName = do - ps <- queryPageCats url pgName - putStrLn ("Page " ++ show pgName ++ " is a member of the following categories: ") - mapM_ (putStrLn.toTitle) ps - where - toTitle pg = ' ':pgTitle pg - -mbCons :: Maybe a -> [a] -> [a] -mbCons Nothing xs = xs -mbCons (Just x) xs = x:xs - +{- + 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.Import as CatMem + +import MediaWiki.API.Query.Categories.Import as Cats + +import Util.GetOpts +import Data.List + +-- begin option handling +data Options + = Options + { optWiki :: String + , optUser :: Maybe String + , optPass :: Maybe String + , optCat :: Maybe String + , optPage :: Maybe String + } + +nullOptions :: Options +nullOptions = Options + { optWiki = "http://en.wikipedia.org/w/" + , optUser = Nothing + , optPass = Nothing + , optCat = Nothing + , optPage = 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" + , Option ['P'] ["page"] + (ReqArg (\ x o -> o{optPage=Just x}) "PAGE") + "the page title to list category pages for" + ] + +-- 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' + +queryPageCats :: URLString -> String -> IO [PageTitle] +queryPageCats url pgName = queryPageCats' emptyCategoriesRequest [] + where + queryPageCats' cReq acc = do + let req = emptyXmlRequest (mkQueryAction (queryPage pgName) cReq) + mb <- webGetXml Cats.stringXml url req + case mb of + Nothing -> fail ("Failed to fetch page" ++ pgName ++ " from " ++ url) + Just c -> do + let acc' = (acc ++ clPages c) + case clContinue c of + Nothing -> return (concatMap snd acc') + Just x -> queryPageCats' cReq{clContinueFrom=Just x} acc' + +main :: IO () +main = do + (opts, fs) <- processOptions option_descr nullOptions + 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 + case mbCons (optPage opts) fs of + [] -> return () + xs -> mapM_ (showPages 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 + +showPages :: URLString -> String -> IO () +showPages url pgName = do + ps <- queryPageCats url pgName + putStrLn ("Page " ++ show pgName ++ " is a member of the following categories: ") + mapM_ (putStrLn.toTitle) ps + where + toTitle pg = ' ':pgTitle pg + +mbCons :: Maybe a -> [a] -> [a] +mbCons Nothing xs = xs +mbCons (Just x) xs = x:xs + diff --git a/examples/Util/GetOpts.hs b/examples/Util/GetOpts.hs --- a/examples/Util/GetOpts.hs +++ b/examples/Util/GetOpts.hs @@ -12,34 +12,62 @@ -- -- So, to correctly attribute the source of the bulk of the functionality -- provided, here's its module header: --- +-- -- Module : System.Console.GetOpt -- Copyright : (c) Sven Panne Oct. 1996 (small changes Dec. 1997) -- License : BSD-style (see the file libraries\/core\/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- --- A Haskell port of GNU's getopt library +-- A Haskell port of GNU's getopt library -- module Util.GetOpts ( module System.Console.GetOpt - , getOpt2 -- :: ArgOrder (a->a) + , getOpt2 -- :: ArgOrder (a->a) -- -> [OptDescr (a->a)] -- -> [String] -- -> a -- -> (a,[String],[String]) , usageInfo2 -- :: String -> [OptDescr a] -> String + + , parseOptions -- :: [OptDescr (a -> a)] + -- :: a + -- -> [String] + -- -> (a, [String], [String]) + , processOptions -- :: [OptDescr (a -> a)] + -- -> a + -- -> IO (a, [String]) ) where import Prelude import Data.List ( isPrefixOf ) import Text.PrettyPrint ---import Util.Pretty import System.Console.GetOpt +import System.IO +import System.Environment +import System.Exit + +import Control.Monad ( when ) + +processOptions :: [OptDescr (a -> a)] + -> a + -> IO (a, [String]) +processOptions descriptors nullVal = do + ls <- getArgs + let (opts, ws, es) = parseOptions descriptors nullVal ls + when (not $ null es) $ do + hPutStrLn stderr (unlines es) + hPutStrLn stderr ("(try '--help' for list of options supported.)") + exitFailure + return (opts, ws) + +parseOptions :: [OptDescr (a -> a)] -> a -> [String] -> (a, [String], [String]) +parseOptions descriptors nullVal argv = getOpt2 Permute descriptors argv nullVal + {- | The @getOpt@ provided @System.Console.GetOpt@ returns a list of values representing the options found present in an @argv@-vector. @@ -51,7 +79,7 @@ to be quite a bit less cumbersome to work with, leaving you at the end with a single value (the record) packaging up all the options setting. - + With @getOpt@, you normally end up (essentially) having to write a sub parser of the list of values returned, which just adds even more bulk to your code, for very little benefit. @@ -75,7 +103,7 @@ (opt,rest) = getNext arg args optDescr (st',xs,es) = getOpt2 ordering optDescr rest st --- getOpt2 supporting code - copied verbatim from System.Console.GetOpt +-- getOpt2 supporting code - copied verbatim from System.Console.GetOpt -- as it isn't exported. data OptKind a -- kind of cmd line arg (internal use only): @@ -155,7 +183,7 @@ usageInfo2 header optDescr = render $ vcat $ text header : table where (ss, ls, descs) = unzip3 $ map fmtOpt optDescr - table = + table = let (c1, ssd) = sameLen ss (c2, lsd) = sameLen ls in @@ -188,11 +216,11 @@ -- | Simple line formatting of a paragraph, introducing line breaks -- whenever length exceeds that of the first argument. fitText :: Int -> String -> Doc -fitText width s = +fitText width s = vcat $ map (hsep . (map text)) (fit 0 [] (words s)) where - -- fill up lines left-to-right, introducing line breaks + -- fill up lines left-to-right, introducing line breaks -- whenever line length exceeds 'width'. fit :: Int -> [String] -> [String] -> [[String]] fit _ acc [] = [reverse acc] diff --git a/mediawiki.cabal b/mediawiki.cabal --- a/mediawiki.cabal +++ b/mediawiki.cabal @@ -1,149 +1,134 @@ -Name: mediawiki -Version: 0.2.4 -License: BSD3 -License-file: LICENSE -Category: Web -Synopsis: Interfacing with the MediaWiki API -Description: - A complete Haskell binding to the MediaWiki API letting you - programmatically access (read and write) MediaWiki content. - . - See and - for more. -Author: Sigbjorn Finne -Maintainer: Sigbjorn Finne -Cabal-version: >= 1.2 -build-type: Simple -extra-source-files: README - examples/ListCat.hs - examples/Util/GetOpts.hs - -flag old-base - description: Old, monolithic base - 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: xml, HTTP >= 3001, network, mime, utf8-string - if flag(old-base) - Build-Depends: base < 3 - else - Build-Depends: base >= 4 - - if impl(ghc >= 6.10) - cpp-options: -DEXTENSIBLE_EXCEPTIONS - -executable main { - if flag(old-base) - Build-Depends: base < 3 - else - Build-Depends: base >= 4 - main-is: Main.hs - ghc-options: -Wall -fglasgow-exts - if impl(ghc >= 6.10) - cpp-options: -DEXTENSIBLE_EXCEPTIONS -} - -executable listCat { - build-depends: pretty - if flag(old-base) - Build-Depends: base < 3 - else - Build-Depends: base >= 4 - main-is: examples/ListCat.hs - ghc-options: -Wall -fglasgow-exts -iexamples - if impl(ghc >= 6.10) - CPP-options: -DEXTENSIBLE_EXCEPTIONS -} +Name: mediawiki +Version: 0.2.6 +License: BSD3 +License-file: LICENSE +Category: Web +Synopsis: Interfacing with the MediaWiki API +Description: + A complete Haskell binding to the MediaWiki API letting you + programmatically access (read and write) MediaWiki content. + . + See and + for more. +Author: Sigbjorn Finne +Maintainer: Sigbjorn Finne +Cabal-version: >= 1.8 +build-type: Simple +extra-source-files: README + examples/ListCat.hs + examples/LinksTo.hs + examples/Util/GetOpts.hs + +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 >= 3 && < 5, xml, HTTP >= 3001, network, mime, utf8-string + +executable main { + Build-Depends: mediawiki, base >= 3 && < 5, xml, HTTP >= 3001, network, mime, utf8-string + Main-is: Main.hs + Ghc-options: -Wall +} + +executable listCat { + Build-Depends: mediawiki, base >= 3 && < 5, xml, HTTP >= 3001, network, mime, utf8-string, pretty + Main-is: examples/ListCat.hs + Ghc-options: -Wall -iexamples +} + +executable linksTo { + Build-Depends: mediawiki, base >= 4, xml, HTTP >= 3001, network, mime, utf8-string, pretty + Main-is: examples/LinksTo.hs + Ghc-options: -Wall -iexamples +}