;; Copyright (c) 2007,2009, Tony Sidaway
;; All rights reserved.
;; 
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following
;; conditions are met:
;;
;; Redistributions of source code must retain the above copyright notice,
;; this list of conditions and the following disclaimer. 
;; Redistributions in binary form must reproduce the above copyright notice,
;; this list of conditions and the following disclaimer in the documentation
;; and/or other materials provided with the distribution. 
;; Neither the name of the author nor the names of its contributors may
;; be used to endorse or promote products derived from this software
;; without specific prior written permission. 
;; 
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS
;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;; POSSIBILITY OF SUCH DAMAGE.
;
; This module builds on the sxml layer provided by mw-sxml and provides a more
; scheme-like interface to the API, in particular enabling procedures to take
; advantage of the API's generator principle.
;
(module mw-query
  (export prop-info prop-revisions prop-categories prop-imageinfo
          prop-langlinks prop-links prop-templates prop-images prop-extlinks prop-categoryinfo
          prop-duplicatefiles list-allpages list-alllinks
          list-allcategories list-allusers list-allimages list-backlinks list-blocks
          list-categorymembers list-embeddedin list-exturlusage list-imageusage
          list-logevents list-recentchanges list-search list-usercontribs list-watchlist
          list-deletedrevs list-users list-random list-protectedtitles meta-siteinfo
          meta-userinfo meta-allmessages)

  (import chicken scheme data-structures srfi-1 srfi-13 regex)
  (require-extension sxpath mw-raw mw-sxml)
  (include "mw-macros.scm")
;;
;; prop-info: get information about one or more pages
;;
  (define (prop-info source #!rest z #!key prop (limit 'max))
    (mw:check-arguments 'prop-info z '(prop limit))
    (let ((prop (pipify prop)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . info)
                         ,(and-. inlimit limit)
                         ,(and-. inprop prop))))))
;;
;; prop-revisions: generic revision lister
;;
  (define (prop-revisions source #!rest z #!key
                          prop startid endid start end dir user
                          excludeuser expandtemplates section token (limit 'max))
    (mw:check-arguments 'prop-revisions  z
                        '(prop startid endid start end dir user excludeuser expandtemplates
                               section token limit))
    (let ((prop (pipify prop))
          (expandtemplates (boolean expandtemplates)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . revisions)
                         ,(and-. rvlimit limit)
                         ,(and-. rvprop prop)
                         ,(and-. rvstartid startid)
                         ,(and-. rvendid endid)
                         ,(and-. rvstart start)
                         ,(and-. rvend end)
                         ,(and-. rvdir dir)
                         ,(and-. rvuser user)
                         ,(and-. rvexcludeuser excludeuser)
                         ,(and-. rvexpandtemplates expandtemplates)
                         ,(and-. rvsection section)
                         ,(and-. rvtoken token))))))
;;
;; prop-categories: categories pages are included in
;;
  (define (prop-categories source #!rest z #!key prop show categories (limit 'max))
    (mw:check-arguments 'prop-categories z '(prop show categories limit))
    (let ((prop (pipify prop))
          (show (pipify show))
          (categories (pipify categories)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . categories)
                         ,(and-. cllimit limit)
                         ,(and-. clprop prop)
                         ,(and-. clshow show)
                         ,(and-. clcategories categories))))))
;;
;; prop-imageinfo: information about pages in image namespace
;;
  (define (prop-imageinfo source #!rest z #!key prop start end urlwidth urlheight (limit 'max))
    (mw:check-arguments 'prop-imageinfo z '(prop start end urlwidth urlheight limit))
    (let ((prop (pipify prop)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . imageinfo)
                         ,(and-. iilimit limit)
                         ,(and-. iiprop prop)
                         ,(and-. iistart start)
                         ,(and-. iiend end)
                         ,(and-. iiurlwidth urlwidth)
                         ,(and-. iiurlheight urlheight))))))
;;
;; prop-langlinks: list of pages in other languages (interlanguage links)
;;
  (define (prop-langlinks source #!rest z #!key (limit 'max))
    (mw:check-arguments 'prop-langlinks z '(limit))
    (generate-query source
                    (filter-true
                     `((action . query)
                       (prop . langlinks)
                       ,(and-. lllimit limit)))))
;;
;; prop-links: links on the provided pages
;;
  (define (prop-links source #!rest z #!key namespace (limit 'max))
    (mw:check-arguments 'prop-links  z '(namespace limit))
    (let ((namespace (pipify namespace)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . links)
                         ,(and-. pllimit limit)
                         ,(and-. plnamespace namespace))))))
;;
;; prop-templates: list of templates in the pages
;;
  (define (prop-templates source #!rest z #!key namespace (limit 'max))
    (mw:check-arguments 'prop-templates  z '(namespace limit))
    (let ((namespace (pipify namespace)))
      (generate-query source
                      (filter-true
                       `((action . query)
                         (prop . templates)
                         ,(and-. tllimit limit)
                         ,(and-. tlnamespace namespace))))))
;;
;; prop-images: list of images in the pages
;;
  (define (prop-images source #!rest z #!key (limit 'max))
    (mw:check-arguments 'prop-images  z '(limit))
    (generate-query source
                    (filter-true
                     `((action . query)
                       (prop . images)
                       ,(and-. imlimit limit)))))
;;
;; prop-extlinks: list of external links in the pages
;;
  (define (prop-extlinks source #!rest z #!key (limit 'max))
    (mw:check-arguments 'prop-extlinks  z '(limit))
    (generate-query source
                    (filter-true
                     `((action . query)
                       (prop . extlinks)
                       ,(and-. ellimit limit)))))
;;
;; prop-categoryinfo: information about pages in category namespace
;;
  (define (prop-categoryinfo source #!rest z #!key prop show (limit 'max))
    (mw:check-arguments 'prop-categoryinfo z '(prop show limit))
    (generate-query source
                    (filter-true
                     `((action . query)
                       (prop . categoryinfo)
                       ,(and-. ciprop prop)
                       ,(and-. cishow show)
                       ,(and-. cilimit limit)))))
;;
;; prop-duplicatefiles: duplicates of a given file or files
;;
  (define (prop-duplicatefiles source #!rest z #!key (limit 'max))
    (mw:check-arguments 'prop-duplicatefiles z '(limit))
    (generate-query source
                    (filter-true
                     `((action . query)
                       (prop . duplicatefiles)
                       ,(and-. dflimit limit)))))
;;
;; list-allpages: list all pages in a given namespace (main namespace by default)
;;
  (define (list-allpages #!rest z #!key
                         from prefix namespace filterredir filterlanglinks minsize maxsize
                         prtype prlevel dir (limit 'max))
    (mw:check-arguments 'list-allpages  z '(from prefix namespace filterredir filterlanglinks
                                                 minsize maxsize prtype prlevel dir limit))
    (filter-true
     `((action . query)
       (list . allpages)
       ,(and-. aplimit limit)
       ,(and-. apfrom from)
       ,(and-. apprefix prefix)
       ,(and-. apnamespace namespace)
       ,(and-. apfilterredir filterredir)
       ,(and-. apfilterlanglinks filterlanglinks)
       ,(and-. apminsize minsize)
       ,(and-. apmaxsize maxsize)
       ,(and-. apprtype prtype)
       ,(and-. apprlevel prlevel)
       ,(and-. apdir dir))))
;;
;; list-alllinks list all unique links to pages in a given namespace (main namespace by default)
;;
  (define (list-alllinks #!rest z #!key from prefix namespace unique prop (limit 'max))
    (mw:check-arguments 'list-alllinks z '(from prefix namespace unique prop limit))
    (let ((unique (boolean unique)))
      (filter-true
       `((action . query)
         (list . alllinks)
         ,(and-. allimit limit)
         ,(and-. alfrom from)
         ,(and-. alprefix prefix)
         ,(and-. alnamespace namespace)
         ,(and-. alunique unique)
         ,(and-. alprop prop)))))
;;
;; list-allcategories list all categories
;;
  (define (list-allcategories #!rest z #!key from prefix dir (limit 'max))
    (mw:check-arguments 'list-allcategories z '(from prefix dir limit))
    (filter-true
     `((action . query)
       (list . allcategories)
       ,(and-. aclimit limit)
       ,(and-. acfrom from)
       ,(and-. acprefix prefix)
       ,(and-. acdir dir))))
;;
;; list-allusers: list all users
;;
  (define (list-allusers #!rest z #!key from prefix group prop (limit 'max))
    (mw:check-arguments 'list-allusers z '(from prefix group prop limit))
    (let ((prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . allusers)
         ,(and-. aulimit limit)
         ,(and-. aufrom from)
         ,(and-. auprefix prefix)
         ,(and-. augroup group)
         ,(and-. auprop prop)))))
;;
;; list-allimages: list all images
;;
  (define (list-allimages #!rest z #!key
                          from prefix minsize maxsize dir sha1 sha1base36 prop (limit 'max))
    (mw:check-arguments 'list-allimages z '(from prefix minsize maxsize dir sha1 sha1base36
                                                 prop limit))
    (let ((prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . allimages)
         ,(and-. ailimit limit)
         ,(and-. aifrom from)
         ,(and-. aiprefix prefix)
         ,(and-. aiminsize minsize)
         ,(and-. aimaxsize maxsize)
         ,(and-. aidir dir)
         ,(and-. aisha1 sha1)
         ,(and-. aisha1base36 sha1base36)
         ,(and-. aiprop prop)))))
;;
;; list-backlinks: what links here
;;
  (define (list-backlinks title #!rest z #!key
                          namespace filterredir redirect (limit 'max))
    (mw:check-arguments 'list-backlinks  z '(namespace filterredir redirect limit))
    (let ((namespace (pipify namespace))
          (redirect (boolean redirect)))
      (filter-true
       `((action . query)
         (list . backlinks)
         ,(and-. bllimit limit)
         (bltitle . ,title)
         ,(and-. blnamespace namespace)
         ,(and-. blredirect redirect)
         ,(and-. blfilterredir filterredir)))))
;;
;; list-blocks: list blocks
;;
  (define (list-blocks #!rest z #!key start end dir ids users ip prop (limit 'max))
    (mw:check-arguments 'list-blocks z '(start end dir ids users ip prop limit))
    (let ((prop (pipify prop))
          (users (pipify users)))
      (filter-true
       `((action . query)
         (list . blocks)
         ,(and-. bklimit limit)
         ,(and-. bkstart start)
         ,(and-. bkend end)
         ,(and-. bkdir dir)
         ,(and-. bkids ids)
         ,(and-. bkusers users)
         ,(and-. bkip ip)
         ,(and-. bkprop prop)))))
;;
;; list-categorymembers: members of a category
;;
  (define (list-categorymembers title #!rest z #!key
                           namespace  start end startsortkey endsortkey
                           sort dir expandtemplates section token
                           prop (limit 'max))
    (mw:check-arguments 'list-categorymembers  z '(namespace start end startsortkey
                                                              endsortkey sort dir limit))
    (let ((prop (pipify prop))
          (namespace (pipify namespace)))
      (filter-true
       `((action . query)
         (list . categorymembers)
         ,(and-. cmlimit limit)
         (cmtitle . ,title)
         ,(and-. cmnamespace namespace)
         ,(and-. cmstart start)
         ,(and-. cmend end)
         ,(and-. cmstartsortkey startsortkey)
         ,(and-. cmendsortkey endsortkey)
         ,(and-. cmsort sort)
         ,(and-. cmdir dir)))))
;;
;; list-embeddedin: pages that transclude a page
;;
  (define (list-embeddedin title #!rest z #!key namespace filterredir (limit 'max))
    (mw:check-arguments 'list-embeddedin  z '(namespace filterredir limit))
    (let ((namespace (pipify namespace)))
      (filter-true
       `((action . query)
         (list . embeddedin)
         ,(and-. eilimit limit)
         (eititle . ,title)
         ,(and-. einamespace namespace)
         ,(and-. eifilterredir filterredir)))))
;;
;; list-exturlusage: list of pages that link to a URL
;;
  (define (list-exturlusage #!rest z #!key
                            query protocol namespace prop offset (limit 'max))
    (mw:check-arguments 'list-exturlusage  z '(query protocol namespace prop offset limit))
    (let ((prop (pipify prop))
          (namespace (pipify namespace)))
      (filter-true
       `((action . query)
         (list . exturlusage)
         ,(and-. eulimit limit)
         ,(and-. euquery query)
         ,(and-. euprotocol protocol)
         ,(and-. eunamespace namespace)
         ,(and-. euprop prop)
         ,(and-. euoffset offset)))))
;;
;; list-imageusage: list of pages using a certain image
;;
  (define (list-imageusage title #!rest z #!key namespace filterredir redirect (limit 'max))
    (mw:check-arguments 'list-imageusage  z '(namespace filterredir redirect limit))
    (let ((namespace (pipify namespace))
          (redirect (boolean redirect)))
      (filter-true
       `((action . query)
         (list . imageusage)
         ,(and-. iulimit limit)
         ,(and-. iunamespace namespace)
         ,(and-. iufilterredir filterredir)
         ,(and-. iuredirect redirect)))))
;;
;; list-logevents: list of logged events
;;
  (define (list-logevents #!rest z #!key prop type user title start end dir (limit 'max))
    (mw:check-arguments 'list-page-imageusage  z '(prop type user title start end dir limit))
    (let ((prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . logevents)
         ,(and-. lelimit limit)
         ,(and-. leprop prop)
         ,(and-. letype type)
         ,(and-. leuser user)
         ,(and-. letitle title)
         ,(and-. lestart start)
         ,(and-. leend end)
         ,(and-. ledir dir)))))
;;
;; list-recentchanges: recent changes
;;
  (define (list-recentchanges #!rest z #!key
                              start end dir namespace titles user excludeuser type
                              show prop (limit 'max))
    (mw:check-arguments 'list-recentchanges  z '(start end dir namespace titles user
                                                       excludeuser type show prop limit))
    (let ((namespace (pipify namespace))
          (titles (pipify titles))
          (type (pipify type))
          (show (pipify show))
          (prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . recentchanges)
         ,(and-. rclimit limit)
         ,(and-. rcstart start)
         ,(and-. rcend end)
         ,(and-. rcdir dir)
         ,(and-. rcnamespace namespace)
         ,(and-. rctitles titles)
         ,(and-. rcuser user)
         ,(and-. rcexcludeuser excludeuser)
         ,(and-. rctype type)
         ,(and-. rcshow show)
         ,(and-. rcprop prop)))))
;;
;; list-search: search
;;
  (define (list-search search #!rest z #!key what namespace redirects (limit 'max))
    (mw:check-arguments 'list-search z '(what namespace redirects limit))
    (let ((namespace (pipify namespace))
          (redirects (boolean redirects)))
      (filter-true
       `((action . query)
         (list . search)
         ,(and-. srlimit limit)
         (srsearch . ,search)
         ,(and-. srwhat what)
         ,(and-. srnamespace namespace)
         ,(and-. srredirects redirects)))))
;;
;; list-usercontribs
;;
  (define (list-usercontribs #!rest z #!key
                              user userprefix start end dir namespace show prop (limit 'max))
    (mw:check-arguments 'list-usercontribs z
                        '(user userprefix start end dir namespace show prop limit))
    (let ((show (pipify show))
          (prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . usercontribs)
         ,(and-. uclimit limit)
         ,(and-. ucuser user)
         ,(and-. ucuserprefix userprefix)
         ,(and-. ucstart start)
         ,(and-. ucend end)
         ,(and-. ucdir dir)
         ,(and-. ucnamespace namespace)
         ,(and-. ucshow show)
         ,(and-. ucprop prop)))))
;;
;; list-watchlist: list logged in user's watchlist
;;
  (define (list-watchlist #!rest z #!key
                             start end dir namespace user excludeuser allrev show prop
                             (limit 'max))
    (mw:check-arguments 'list-watchlist z '(start end dir namespace user excludeuser
                                                     allrev show prop limit))
    (let ((namespace (pipify namespace))
          (show (pipify show))
          (prop (pipify prop))
          (allrev (boolean allrev)))
      (filter-true
       `((action . query)
         (list . watchlist)
         ,(and-. wllimit limit)
         ,(and-. wlstart start)
         ,(and-. wlend end)
         ,(and-. wldir dir)
         ,(and-. wlnamespace namespace)
         ,(and-. wluser user)
         ,(and-. wlexcludeuser excludeuser)
         ,(and-. wlallrev allrev)
         ,(and-. wlshow show)
         ,(and-. wlprop prop)))))
;;
;; list-deletedrevs: list deleted revisions of a page
;;
  (define (list-deletedrevs #!rest z #!key
                                 titles user excludeuser start end namespace unique
                                 from prop (limit 'max))
    (mw:check-arguments 'list-deletedrevs z '(titles user excludeuser start end namespace
                                                     unique from prop limit))
    (let ((titles (pipify titles))
          (prop (pipify prop))
          (unique (boolean unique)))
      (filter-true
       `((action . query)
         (list . deletedrevs)
         ,(and-. drlimit limit)
         ,(and-. drtitles titles)
         ,(and-. druser user)
         ,(and-. drexcluderuser excludeuser)
         ,(and-. drstart start)
         ,(and-. drend end)
         ,(and-. drnamespace namespace)
         ,(and-. drunique unique)
         ,(and-. drfrom from)
         ,(and-. drprop prop)))))
;;
;; list-users: information about one or more users
;;
  (define (list-users users #!rest z #!key token prop (limit 'max))
    (mw:check-arguments 'list-users z '(token prop limit))
    (let ((users (pipify users))
          (prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . users)
         ,(and-. uslimit limit)
         ,(and-. ususers users)
         ,(and-. ustoken token)
         ,(and-. usprop prop)))))
;;
;; list-random: list of random pages
;;
  (define (list-random #!rest z #!key namespace redirect (limit 'max))
    (mw:check-arguments 'list-random z '(namespace redirect limit))
    (let ((namespace (pipify namespace))
          (redirect (boolean redirect)))
      (filter-true
       `((action . query)
         (list . random)
         ,(and-. rnlimit limit)
         ,(and-. rnnamespace namespace)
         ,(and-. rnredirect redirect)))))
;;
;; list-protectedtitles: list pages protected from creation
;;
  (define (list-protectedtitles #!rest z #!key start end dir namespace level prop (limit 'max))
    (mw:check-arguments 'list-protectedtitles z '(start end dir namespace level prop limit))
    (let ((namespace (pipify namespace))
          (prop (pipify prop)))
      (filter-true
       `((action . query)
         (list . protectedtitles)
         ,(and-. ptlimit limit)
         ,(and-. ptstart start)
         ,(and-. ptend end)
         ,(and-. ptdir dir)
         ,(and-. ptnamespace namespace)
         ,(and-. ptlevel level)
         ,(and-. ptprop prop)))))
;;
;; meta-siteinfo: information about the wiki site
;;
  (define (meta-siteinfo #!rest z #!key prop filteriw showalldb)
    (mw:check-arguments 'meta-siteinfo z '(prop filteriw showalldb))
    (let ((prop (pipify prop))
          (showalldb (boolean showalldb)))
      (filter-true
       `((action . query)
         (meta . siteinfo)
         ,(and-. siprop prop)
         ,(and-. sifilteriw filteriw)
         ,(and-. sishowalldb showalldb)))))
;;
;; meta-userinfo: information about the user
;;
  (define (meta-userinfo #!rest z #!key prop)
    (mw:check-arguments 'meta-userinfo z '(prop))
    (let ((prop (pipify prop)))
      (filter-true
       `((action . query)
         (meta . userinfo)
         ,(and-. uiprop prop)))))
;;
;; meta-allmessages: all interface messages
;;
  (define (meta-allmessages #!rest z #!key messages filter lang)
    (mw:check-arguments 'meta-allmessages z '(messages filter lang))
    (let ((messages (pipify messages)))
      (filter-true
       `((action . query)
         (meta . allmessages)
         ,(and-. ammessages messages)
         ,(and-. amfilter filter)
         ,(and-. amlang lang)))))
  )