hxt-expat (empty) → 9.1.0
raw patch · 6 files changed
+408/−0 lines, 6 filesdep +basedep +bytestringdep +haskell98setup-changed
Dependencies added: base, bytestring, haskell98, hexpat, hxt
Files
- LICENSE +9/−0
- Setup.lhs +8/−0
- examples/hparser/HXmlParser.hs +178/−0
- hxt-expat.cabal +37/−0
- src/Text/XML/HXT/Arrow/ExpatInterface.hs +149/−0
- src/Text/XML/HXT/Expat.hs +27/−0
+ LICENSE view
@@ -0,0 +1,9 @@+The MIT License++Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/runhaskell++> module Main where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ examples/hparser/HXmlParser.hs view
@@ -0,0 +1,178 @@+-- ------------------------------------------------------------++{- |+ Module : HXmlParser+ Copyright : Copyright (C) 2005-2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt+ Maintainer : uwe@fh-wedel.de+ Stability : experimental+ Portability: portable++ HXmlParser - Validating XML Parser of the Haskell XML Toolbox++ XML well-formed checker and validator.++ this program may be used as example main program for the+ arrow API of the Haskell XML Toolbox++ commandline parameter evaluation and+ and return code is the most complicated part+ of this example application++-}++-- ------------------------------------------------------------++module Main+where++import Text.XML.HXT.Core -- import all stuff for parsing, validating, and transforming XML+import Text.XML.HXT.Expat -- import Expat parser+import Text.XML.HXT.Arrow.XmlState.TypeDefs++import System.IO -- import the IO and commandline option stuff+import System.Environment+import System.Console.GetOpt+import System.Exit++-- ------------------------------------------------------------++-- |+-- the main program of the Haskell XML Validating Parser++main :: IO ()+main+ = do+ argv <- getArgs -- get the commandline arguments+ (al, src) <- cmdlineOpts argv -- and evaluate them, return a key-value list+ [rc] <- runX (parser al src) -- run the parser arrow+ exitProg (rc >= c_err) -- set return code and terminate++-- ------------------------------------------------------------++exitProg :: Bool -> IO a+exitProg True = exitWith (ExitFailure (-1))+exitProg False = exitWith ExitSuccess++-- ------------------------------------------------------------++-- |+-- the /real/ main program+--+-- get wellformed document, validates document, propagates and check namespaces+-- and controls output++parser :: SysConfigList -> String -> IOSArrow b Int+parser config src+ = configSysVars ((withExpat True) : config) -- set expat parser+ >>>+ readDocument (withTrace 2 : config) src+ >>>+ ( ( traceMsg 1 "start processing document"+ >>>+ processDocument $< getSysAttr "action"+ >>>+ traceMsg 1 "document processing finished"+ )+ `when`+ documentStatusOk+ )+ >>>+ traceSource+ >>>+ traceTree+ >>>+ issueExpatErr -- this is only of interest when parsing is done lazily, with "withExpat False" config+ >>>+ ( ( writeDocument [] $< getSysAttr "output-file" )+ `whenNot`+ ( getSysAttr "no-output" >>> isA (== "1") )+ )+ >>>+ getErrStatus++-- simple example of a processing arrow, selected by a command line option++processDocument :: String -> IOSArrow XmlTree XmlTree+processDocument "only-text"+ = traceMsg 1 "selecting plain text"+ >>>+ processChildren (deep isText)++processDocument "indent"+ = traceMsg 1 "indent document"+ >>>+ indentDoc++processDocument "show-tree"+ = traceMsg 1 "show-tree document"+ >>>+ writeDocument [withShowTree yes] ""++processDocument _action+ = traceMsg 1 "default action: do nothing"+ >>>+ this++-- ------------------------------------------------------------+--+-- the options definition part+-- see doc for System.Console.GetOpt++progName :: String+progName = "HXmlParser"++options :: [OptDescr SysConfig]+options+ = generalOptions+ +++ inputOptions+ +++ outputOptions+ +++ [ Option "q" ["no-output"] (NoArg $ withSysAttr "no-output" "1") "no output of resulting document"+ , Option "x" ["action"] (ReqArg (withSysAttr "action") "ACTION") "actions are: only-text, indent, no-op"+ , Option "Z" ["lazy"] (NoArg $ withExpat False ) "errors are not checked during parse"+ , Option "N" ["not-lazy"] (NoArg $ withExpat True ) "errors are checked during parse"+ ]+ +++ showOptions++usage :: [String] -> IO a+usage errl+ | null errl+ = do+ hPutStrLn stdout use+ exitProg False+ | otherwise+ = do+ hPutStrLn stderr (concat errl ++ "\n" ++ use)+ exitProg True+ where+ header = "HXmlParser - Validating XML Parser of the Haskell XML Toolbox with Arrow Interface\n" +++ "XML well-formed checker, DTD validator, Relax NG validator.\n\n" +++ "Usage: " ++ progName ++ " [OPTION...] [URI or FILE]"+ use = usageInfo header options++cmdlineOpts :: [String] -> IO (SysConfigList, String)+cmdlineOpts argv+ = case (getOpt Permute options argv) of+ (scfg,n,[])+ -> do+ sa <- src n+ help (getConfigAttr a_help scfg) sa+ return (scfg, sa)+ (_,_,errs)+ -> usage errs+ where+ src [] = return []+ src [uri] = return uri+ src _ = usage ["only one input uri or file allowed\n"]++ help "1" _ = usage []+ help _ [] = usage ["no input uri or file given\n"]+ help _ _ = return ()++-- ------------------------------------------------------------
+ hxt-expat.cabal view
@@ -0,0 +1,37 @@+Name: hxt-expat+Version: 9.1.0+Synopsis: Expat parser for HXT+Description: The Expat interface for the HXT.+License: OtherLicense+License-file: LICENSE+Author: Uwe Schmidt+Maintainer: Uwe Schmidt <uwe@fh-wedel.de>+Stability: Experimental+Category: XML+Homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html+Copyright: Copyright (c) 2010 Uwe Schmidt+Build-type: Simple+Cabal-version: >=1.6++extra-source-files:+ examples/hparser/HXmlParser.hs++library+ exposed-modules:+ Text.XML.HXT.Expat++ other-modules:+ Text.XML.HXT.Arrow.ExpatInterface++ hs-source-dirs: src++ ghc-options: -Wall+ ghc-prof-options: -auto-all -caf-all++ extensions: MultiParamTypeClasses DeriveDataTypeable FunctionalDependencies FlexibleInstances++ build-depends: base >= 4 && < 5,+ haskell98 >= 1 && < 2,+ bytestring >= 0.9 && < 1,+ hexpat >= 0.19.3 && < 1,+ hxt >= 9.1 && < 10
+ src/Text/XML/HXT/Arrow/ExpatInterface.hs view
@@ -0,0 +1,149 @@+-- ------------------------------------------------------------++{- |+ Module : Text.XML.HXT.Arrow.ExpatInterface+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Internal Interface for Expat Parser++-}++-- ------------------------------------------------------------++module Text.XML.HXT.Arrow.ExpatInterface+where++import Text.XML.Expat.Tree++import Text.XML.HXT.Core+import qualified Text.XML.HXT.Core as X+import qualified Text.XML.HXT.DOM.XmlNode as XN+import Text.XML.HXT.Arrow.XmlState.TypeDefs+import Text.XML.HXT.Parser.XhtmlEntities ( xhtmlEntities )++-- import Debug.Trace++-- ------------------------------------------------------------++{- |+ The system config option to enable the expat parser++Here is an example, how to use it:++> ...+> import Text.HXT.XML.Core+> import Text.HXT.XML.Expat+> ...+>+> readDocument [ withExpat True ] "some-file.xml"+> ...++reads the given document and parses it with the expat parser.+There is no validation enabled. The parameter to @withExpat@ determines, whether parsing+is done strict. Here strict parsing is enabled. When strict parsing is used,+the parse is immediately checked for parser errors, and possible errors are issued.+When set to non-strict parsing, error checking is delayed and may be done later +with the @issueExpatErr@ arrow.++When HTML parsing is enabled, the expat parser will be configured with the HTML enitity reference+resolver, else only the predefined XML enitities will be substituted.+-}++withExpat :: Bool -> SysConfig+withExpat strict = setS (theExpat .&&&.+ theTagSoup .&&&.+ theExpatParser .&&&.+ theExpatErrors+ ) (True, (False, (parseExpat strict, none)))++-- | Turns off expat parsing. The build in HXT parsers will be used.++withoutExpat :: SysConfig+withoutExpat = setS theExpat False++-- ------------------------------------------------------------++parseExpat :: Bool -> IOSArrow XmlTree XmlTree+parseExpat strict = parse1 $<< ( getAttrValue transferEncoding+ &&&+ getSysVar theLowerCaseNames+ )+ where+ parse1 enc isHtml = traceMsg 1 ( "parse document with expat parser, encoding is " +++ show enc ++ ", issue errors is " ++ show strict +++ ", HTML entity subst is " ++ show isHtml+ )+ >>>+ ( substContents $< parse2 )+ where+ substContents (t, e)+ | strict = case e of+ Nothing -> setChildren [t]+ Just _ -> ee e+ >>> + setChildren []+ | otherwise = perform ( constA (ee e)+ >>>+ traceMsg 1 "set expat error"+ >>>+ setSysVar theExpatErrors + >>>+ none+ )+ >>>+ setChildren [t]+ where+ ee Nothing = none+ ee (Just (XMLParseError msg loc))+ = issueErr ("Expat error at " ++ show (xmlLineNumber loc) +++ ":" ++ show (xmlColumnNumber loc) ++ ":" ++ msg+ )++ parse2 :: IOSArrow XmlTree (XmlTree, Maybe XMLParseError)+ parse2 = xshowBlob X.getChildren -- expat parser wants bytestrings as input+ >>>+ arr ( parse parseOptions+ >>>+ first uNodeStringToXmlTree+ )++ parseOptions+ | isHtml = parseO { entityDecoder = Just htmlEncoder }+ | otherwise = parseO+ where+ parseO = defaultParseOptions { overrideEncoding = expatEnc }++ htmlEncoder :: String -> Maybe String+ htmlEncoder ent+ = -- traceShow ("\n" ++ ent ++ "\n") $+ fmap (toEnum >>> (:[])) . lookup ent $ xhtmlEntities++ expatEnc = lookup enc [ (X.usAscii, ASCII)+ , (X.utf8, UTF8)+ , (X.utf16, UTF16)+ , (X.isoLatin1, ISO88591)+ ]++-- | In case of lazy parsing check for possible errors++issueExpatErr :: IOStateArrow s b b+issueExpatErr = withoutUserState $ perform $+ constA undefined >>> applyA (getSysVar theExpatErrors)+++-- ------------------------------------------------------------++uNodeStringToXmlTree :: UNode String -> XmlTree+uNodeStringToXmlTree (Element n al cl)+ = XN.mkElement (mkName n)+ (map (\ (an, av) -> XN.mkAttr (mkName an) [XN.mkText av]) al)+ (map uNodeStringToXmlTree cl)+uNodeStringToXmlTree (Text t)+ = XN.mkText t++-- ------------------------------------------------------------
+ src/Text/XML/HXT/Expat.hs view
@@ -0,0 +1,27 @@+-- ------------------------------------------------------------++{- |+ Module : Text.XML.HXT.Expat+ Copyright : Copyright (C) 2010 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Stability : experimental+ Portability: portable++ Interface for Expat XML Parser++-}++-- ------------------------------------------------------------++module Text.XML.HXT.Expat+ ( withExpat+ , withoutExpat+ , issueExpatErr+ )+where++import Text.XML.HXT.Arrow.ExpatInterface++-- ------------------------------------------------------------