diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,37 @@ += mediawiki - Accessing MediaWiki from Haskell = + +'mediawiki' is a Haskell package providing a comprehensive binding to +the programmatic interface to MediaWiki (aka, 'the MediaWiki API') - + + http://www.mediawiki.org/wiki/API + +The binding is allegedly complete (2008-11-17), letting you write +applications in Haskell that accesses and (if enabled by target Wiki) +manipulate content on MediaWiki pages. + += Getting started = + +For some code samples showing you how to get started using this +API binding, have a look in the examples/ directory. + += Building and installing = + +This package is provided in Cabal form, so only thing you need to +do to get going is: + + foo% runghc Setup configure + foo% runghc Setup build + foo% runghc Setup install + +The package depends on a bunch of other packages though, so you +need to have them built&installed, as well. They are: + + * HTTP: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HTTP + * xml: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xml + * mime: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mime + * utf8-string: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/utf8-string + += Feedback / question = + +Please send them to sof@forkIO.com , and I'll try to respond to them +as best/quickly as possible. diff --git a/examples/Util/GetOpts.hs b/examples/Util/GetOpts.hs new file mode 100644 --- /dev/null +++ b/examples/Util/GetOpts.hs @@ -0,0 +1,203 @@ +-- | +-- +-- Module : Util.GetOpts +-- Copyright : (c) 2004-2008, Sigbjorn Finne. +-- +-- Maintainer : sof@forkIO.com +-- Stability : provisional +-- Portability : portable +-- +-- Accumulator-style command-line option parsing; minor extension +-- of @System.Console.GetOpt@ (whose interface this module re-exports). +-- +-- 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 +-- + +module Util.GetOpts + ( module System.Console.GetOpt + , getOpt2 -- :: ArgOrder (a->a) + -- -> [OptDescr (a->a)] + -- -> [String] + -- -> a + -- -> (a,[String],[String]) + , usageInfo2 -- :: String -> [OptDescr a] -> String + ) where + +import Prelude +import Data.List ( isPrefixOf ) +import Text.PrettyPrint +--import Util.Pretty +import System.Console.GetOpt + +{- | + The @getOpt@ provided @System.Console.GetOpt@ returns a list of + values representing the options found present in an @argv@-vector. + + @getOpt2@ offers a different view -- the options are represented + by a single value instead, i.e., you define a labelled field record + type representing the options supported, and have the OptDescr + elements just update the contents of that record. This has proven + 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. +-} +getOpt2 :: ArgOrder (a -> a) -- non-option handling + -> [OptDescr (a -> a)] -- option descriptors + -> [String] -- the commandline arguments + -> a -- initial state + -> (a,[String],[String]) -- (options,non-options,error messages) +getOpt2 _ _ [] st = (st,[],[]) +getOpt2 ordering optDescr (arg:args) st = procNextOpt opt ordering + where procNextOpt (Opt f) _ = (f st',xs,es) + procNextOpt (NonOpt x) RequireOrder = (st,x:rest,[]) + procNextOpt (NonOpt x) Permute = (st',x:xs,es) + procNextOpt (NonOpt x) (ReturnInOrder f) = (f x st', xs,es) + procNextOpt EndOfOpts RequireOrder = (st',rest,[]) + procNextOpt EndOfOpts Permute = (st',rest,[]) + procNextOpt EndOfOpts (ReturnInOrder f) = (foldr f st' rest,[],[]) + procNextOpt (OptErr e) _ = (st',xs,e:es) + + (opt,rest) = getNext arg args optDescr + (st',xs,es) = getOpt2 ordering optDescr rest st + +-- 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): + = Opt a -- an option + | NonOpt String -- a non-option + | EndOfOpts -- end-of-options marker (i.e. "--") + | OptErr String -- something went wrong... + +-- take a look at the next cmd line arg and decide what to do with it +getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) +getNext ('-':'-':[]) rest _ = (EndOfOpts,rest) +getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr +getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr +getNext a rest _ = (NonOpt a,rest) + +-- handle long option +longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) +longOpt ls rs optDescr = long ads arg rs + where (opt,arg) = break (=='=') ls + options = [ o | o@(Option _ xs _ _) <- optDescr, + l <- xs, + opt `isPrefixOf` l + ] + ads = [ ad | Option _ _ ad _ <- options ] + optStr = ("--"++opt) + + long (_:_:_) _ rest = (errAmbig options optStr,rest) + long [NoArg a ] [] rest = (Opt a,rest) + long [NoArg _ ] ('=':_) rest = (errNoArg optStr,rest) + long [ReqArg _ d] [] [] = (errReq d optStr,[]) + long [ReqArg f _] [] (r:rest) = (Opt (f r),rest) + long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest) + long [OptArg f _] [] rest = (Opt (f Nothing),rest) + long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest) + long _ _ rest = (errUnrec optStr,rest) + +-- handle short option +shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String]) +shortOpt x ys rest1 optDescr = short ads ys rest1 + where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ] + ads = [ ad | Option _ _ ad _ <- options ] + optStr = '-':[x] + + short (_:_:_) _ rest = (errAmbig options optStr,rest) + short (NoArg a :_) [] rest = (Opt a,rest) + short (NoArg a :_) xs rest = (Opt a,('-':xs):rest) + short (ReqArg _ d:_) [] [] = (errReq d optStr,[]) + short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest) + short (ReqArg f _:_) xs rest = (Opt (f xs),rest) + short (OptArg f _:_) [] rest = (Opt (f Nothing),rest) + short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest) + short [] [] rest = (errUnrec optStr,rest) + short [] xs rest = (errUnrec optStr,('-':xs):rest) + +-- miscellaneous error formatting + +errAmbig :: [OptDescr a] -> String -> OptKind a +errAmbig ods optStr = + OptErr $ usageInfo header ods + where header = "option '" ++ optStr ++ "' is ambiguous; could be one of:" + +errReq :: String -> String -> OptKind a +errReq d optStr = + OptErr $ "option '" ++ optStr ++ "' requires an argument " ++ d + +errUnrec :: String -> OptKind a +errUnrec optStr = + OptErr $ "unrecognized option '" ++ optStr ++ "'" + +errNoArg :: String -> OptKind a +errNoArg optStr = + OptErr $ "option '" ++ optStr ++ "' doesn't allow an argument" + +usageInfo2 :: String -- header + -> [OptDescr a] -- option descriptors + -> String -- nicely formatted decription of options +usageInfo2 header optDescr = render $ vcat $ text header : table + where + (ss, ls, descs) = unzip3 $ map fmtOpt optDescr + table = + let (c1, ssd) = sameLen ss + (c2, lsd) = sameLen ls + in + zipWith3 (paste (74 - c1 - c2)) ssd lsd descs + paste c3 x y z = nest 2 $ x <+> space <> y <> space <+> fitText c3 z + sameLen xs = + let width = maximum $ map length xs + in + (width, flushLeft width xs) + flushLeft n xs = [ text $ take n (x ++ repeat ' ') | x <- xs ] + + fmtOpt :: OptDescr a -> (String, String, String) + fmtOpt (Option sos los argdesc descr) = + ( render $ hcat $ punctuate comma $ map (fmtShort argdesc) sos + , render $ hcat $ punctuate comma $ map (fmtLong argdesc) los + , descr + ) + where + fmtShort :: ArgDescr a -> Char -> Doc + fmtShort (NoArg _ ) so = char '-' <> char so + fmtShort (ReqArg _ ad) so = char '-' <> char so <+> text ad + fmtShort (OptArg _ ad) so = char '-' <> char so <+> brackets (text ad) + + fmtLong :: ArgDescr a -> String -> Doc + fmtLong (NoArg _ ) lo = text "--" <> text lo + fmtLong (ReqArg _ ad) lo = text "--" <> text lo <> equals <> text ad + fmtLong (OptArg _ ad) lo = text "--" <> text lo <> equals <> + brackets (text ad) + +-- | Simple line formatting of a paragraph, introducing line breaks +-- whenever length exceeds that of the first argument. +fitText :: Int -> String -> Doc +fitText width s = + vcat $ map (hsep . (map text)) + (fit 0 [] (words s)) + where + -- fill up lines left-to-right, introducing line breaks + -- whenever line length exceeds 'width'. + fit :: Int -> [String] -> [String] -> [[String]] + fit _ acc [] = [reverse acc] + fit n acc (w:ws) + | (n + l) >= width = (reverse (w:acc)) : fit 0 [] ws + | otherwise = fit (n+l+1{-word space-}) (w:acc) ws + where + l = length w diff --git a/mediawiki.cabal b/mediawiki.cabal --- a/mediawiki.cabal +++ b/mediawiki.cabal @@ -1,5 +1,5 @@ Name: mediawiki -Version: 0.2 +Version: 0.2.1 License: BSD3 License-file: LICENSE Category: Web @@ -9,6 +9,9 @@ Maintainer: Sigbjorn Finne Cabal-version: >= 1.2 build-type: Simple +extra-source-files: README + examples/ListCat.hs + examples/Util/GetOpts.hs flag new-base description: Build with new smaller base library