packages feed

xml (empty) → 1.2.6

raw patch · 8 files changed

+785/−0 lines, 8 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,31 @@+(c) 2007 Galois Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.+~                          
+ Setup.hs view
@@ -0,0 +1,7 @@+module Main where++import Distribution.Simple+++main :: IO ()+main = defaultMainWithHooks defaultUserHooks
+ Text/XML/Light.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleInstances #-}+--------------------------------------------------------------------+-- |+-- Module    : Text.XML.Light+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability: portability+--+-- A lightweight XML parsing, filtering and generating library.+--+-- This module reexports functions from:+--+-- * "Text.XML.Light.Types"+--+-- * "Text.XML.Light.Proc"+--+-- * "Text.XML.Light.Input"+--+-- * "Text.XML.Light.Output"+--++module Text.XML.Light (++    module Text.XML.Light,+    module Text.XML.Light.Types,+    module Text.XML.Light.Proc,+    module Text.XML.Light.Input,+    module Text.XML.Light.Output++  ) where++import Text.XML.Light.Types+import Text.XML.Light.Proc+import Text.XML.Light.Input+import Text.XML.Light.Output++-- | Add an attribute to an element.+add_attr :: Attr -> Element -> Element+add_attr a e = add_attrs [a] e++-- | Add some attributes to an element.+add_attrs :: [Attr] -> Element -> Element+add_attrs as e = e { elAttribs = as ++ elAttribs e }++-- | Create an unqualified name.+unqual :: String -> QName+unqual x = blank_name { qName = x }++-- | A smart element constructor which uses the type of its argument+-- to determine what sort of element to make.+class Node t where+  node :: QName -> t -> Element++instance Node ([Attr],[Content]) where+  node n (attrs,cont) = blank_element { elName     = n+                                      , elAttribs  = attrs+                                      , elContent  = cont+                                      }++instance Node [Attr]             where node n as   = node n (as,[]::[Content])+instance Node Attr               where node n a    = node n [a]+instance Node ()                 where node n ()   = node n ([]::[Attr])++instance Node [Content]          where node n cs     = node n ([]::[Attr],cs)+instance Node Content            where node n c      = node n [c]+instance Node ([Attr],Content)   where node n (as,c) = node n (as,[c])+instance Node (Attr,Content)     where node n (a,c)  = node n ([a],[c])++instance Node ([Attr],[Element]) where+  node n (as,cs) = node n (as,map Elem cs)++instance Node ([Attr],Element)   where node n (as,c) = node n (as,[c])+instance Node (Attr,Element)     where node n (a,c)  = node n ([a],c)+instance Node ([Element])        where node n es     = node n ([]::[Attr],es)+instance Node (Element)          where node n e      = node n [e]++instance Node ([Attr],[CData])   where+  node n (as,cs) = node n (as,map Text cs)++instance Node ([Attr],CData)     where node n (as,c) = node n (as,[c])+instance Node (Attr,CData)       where node n (a,c)  = node n ([a],c)+instance Node [CData]            where node n es     = node n ([]::[Attr],es)+instance Node CData              where node n e      = node n [e]++instance Node ([Attr],String)    where+  node n (as,t) = node n (as,blank_cdata { cdData = t })++instance Node (Attr,String)      where node n (a,t)  = node n ([a],t)+instance Node [Char]             where node n t      = node n ([]::[Attr],t)++-- | Create node with unqualified name+unode :: Node t => String -> t -> Element+unode = node . unqual
+ Text/XML/Light/Input.hs view
@@ -0,0 +1,296 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.XML.Light.Input+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability: portable+--+-- Lightweight XML parsing+--++module Text.XML.Light.Input (parseXML,parseXMLDoc) where++import Text.XML.Light.Types+import Text.XML.Light.Proc+import Text.XML.Light.Output(tagEnd)++import Data.Char(isSpace)+import Data.List(isPrefixOf)+import Numeric(readHex)++-- | parseXMLDoc, parse a XMLl document to maybe an element+parseXMLDoc  :: String -> Maybe Element+parseXMLDoc xs  = strip (parseXML xs)+  where strip cs = case onlyElems cs of+                    e : _+                      | "?xml" `isPrefixOf` qName (elName e)+                          -> strip (elContent e)+                      | otherwise -> Just e+                    _ -> Nothing++-- | parseXML to a list of content chunks+parseXML   :: String -> [Content]+parseXML xs = parse $ tokens $ preprocess xs++------------------------------------------------------------------------++parse      :: [Token] -> [Content]+parse []    = []+parse ts    = let (es,_,ts1) = nodes ([],Nothing) [] ts+              in es ++ parse ts1++-- Information about namespaces.+-- The first component is a map that associates prefixes to URIs,+-- the second is the URI for the default namespace, if one was provided.+type NSInfo = ([(String,String)],Maybe String)++nodes :: NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])++nodes ns ps (TokCRef ref : ts) =+  let (es,qs,ts1) = nodes ns ps ts+  in (CRef ref : es, qs, ts1)++nodes ns ps (TokText txt : ts) =+  let (es,qs,ts1) = nodes ns ps ts+      (more,es1)  = case es of+                      Text cd : es1'+                        | cdVerbatim cd == cdVerbatim txt -> (cdData cd,es1')+                      _                                   -> ([],es)++  in (Text txt { cdData = cdData txt ++ more } : es1, qs, ts1)++nodes cur_info ps (TokStart p t as empty : ts) = (node : siblings, open, toks)+  where+  new_name  = annotName new_info t+  new_info  = foldr addNS cur_info as+  node      = Elem Element { elLine    = Just p+                           , elName    = new_name+                           , elAttribs = map (annotAttr new_info) as+                           , elContent = children+                           }++  (children,(siblings,open,toks))+    | empty     = ([], nodes cur_info ps ts)+    | otherwise = let (es1,qs1,ts1) = nodes new_info (new_name:ps) ts+                  in (es1,+                      case qs1 of+                        [] -> nodes cur_info ps ts1+                        _ : qs3 -> ([],qs3,ts1))++nodes ns ps (TokEnd p t : ts)   = let t1 = annotName ns t+                                in case break (t1 ==) ps of+                                  (as,_:_) -> ([],as,ts)+                                  -- Unknown closing tag. Insert as text.+                                  (_,[]) ->+                                    let (es,qs,ts1) = nodes ns ps ts+                                    in (Text CData {+                                               cdLine = Just p,+                                               cdVerbatim = False,+                                               cdData = tagEnd t ""+                                              } : es,qs, ts1)++nodes _ ps []                 = ([],ps,[])+++annotName :: NSInfo -> QName -> QName+annotName (namespaces,def_ns) n =+  n { qURI = maybe def_ns (`lookup` namespaces) (qPrefix n) }++annotAttr :: NSInfo -> Attr -> Attr+annotAttr ns a@(Attr { attrKey = k}) =+  case (qPrefix k, qName k) of+    (Nothing,"xmlns") -> a+    _                 -> a { attrKey = annotName ns k }++addNS :: Attr -> NSInfo -> NSInfo+addNS (Attr { attrKey = key, attrVal = val }) (ns,def) =+  case (qPrefix key, qName key) of+    (Nothing,"xmlns") -> (ns, if null val then Nothing else Just val)+    (Just "xmlns", k) -> ((k, val) : ns, def)+    _                 -> (ns,def)+++-- Lexer -----------------------------------------------------------------------++type LChar              = (Line,Char)+type LString            = [LChar]+data Token              = TokStart Line QName [Attr] Bool  -- is empty?+                        | TokEnd Line QName+                        | TokCRef String+                        | TokText CData+                          deriving Show++tokens             :: String -> [Token]+tokens = tokens' . linenumber 1++tokens' :: LString -> [Token]+tokens' ((_,'<') : c@(_,'!') : cs) = special c cs++tokens' ((_,'<') : cs)   = tag (dropSpace cs) -- we are being nice here+tokens' [] = []+tokens' cs@((l,_):_) = let (as,bs) = breakn ('<' ==) cs+                       in map cvt (decode_text as) ++ tokens' bs++  -- XXX: Note, some of the lines might be a bit inacuarate+  where cvt (TxtBit x)  = TokText CData { cdLine = Just l+                                        , cdVerbatim = False+                                        , cdData = x+                                        }+        cvt (CRefBit x) = case cref_to_char x of+                            Just c -> TokText CData { cdLine = Just l+                                                    , cdVerbatim = False+                                                    , cdData = [c]+                                                    }+                            Nothing -> TokCRef x+++special :: LChar -> LString -> [Token]+special _ ((_,'-') : (_,'-') : cs) = skip cs+  where skip ((_,'-') : (_,'-') : (_,'>') : ds) = tokens' ds+        skip (_ : ds) = skip ds+        skip [] = [] -- unterminated comment++special c ((_,'[') : (_,'C') : (_,'D') : (_,'A') : (_,'T') : (_,'A') : (_,'[')+         : cs) =+  let (xs,ts) = cdata cs+  in TokText CData { cdLine = Just (fst c), cdVerbatim = True, cdData = xs }+                                                                  : tokens' ts+  where cdata ((_,']') : (_,']') : (_,'>') : ds) = ([],ds)+        cdata ((_,d) : ds)  = let (xs,ys) = cdata ds in (d:xs,ys)+        cdata []        = ([],[])++special c cs = tag (c : cs) -- invalid specials are processed as tags+++qualName           :: LString -> (QName,LString)+qualName xs         = let (as,bs) = breakn endName xs+                          (q,n)   = case break (':'==) as of+                                      (q1,_:n1) -> (Just q1, n1)+                                      _         -> (Nothing, as)+                      in (QName { qURI = Nothing, qPrefix = q, qName = n }, bs)+  where endName x = isSpace x || x == '=' || x == '>' || x == '/'++++++tag              :: LString -> [Token]+tag ((p,'/') : cs)    = let (n,ds) = qualName (dropSpace cs)+                        in TokEnd p n : case ds of+                                          (_,'>') : es -> tokens' es+                                          -- tag was not properly closed...+                                          _        -> tokens' ds+tag []            = []+tag cs            = let (n,ds)  = qualName cs+                        (as,b,ts) = attribs (dropSpace ds)+                    in TokStart (fst (head cs)) n as b : ts++attribs          :: LString -> ([Attr], Bool, [Token])+attribs cs        = case cs of+                      (_,'>') : ds -> ([], False, tokens' ds)++                      (_,'/') : ds -> ([], True, case ds of+                                              (_,'>') : es -> tokens' es+                                              -- insert missing >  ...+                                              _ -> tokens' ds)++                      (_,'?') : (_,'>') : ds -> ([], False, tokens' ds)++                      -- doc ended within a tag..+                      []       -> ([],False,[])++                      _        -> let (a,cs1) = attrib cs+                                      (as,b,ts) = attribs cs1+                                  in (a:as,b,ts)++attrib             :: LString -> (Attr,LString)+attrib cs           = let (ks,cs1)  = qualName cs+                          (vs,cs2)  = attr_val (dropSpace cs1)+                      in ((Attr ks (decode_attr vs)),dropSpace cs2)++attr_val           :: LString -> (String,LString)+attr_val ((_,'=') : cs) = string (dropSpace cs)+attr_val cs         = ("",cs)+++dropSpace :: LString -> LString+dropSpace = dropWhile (isSpace . snd)++-- | Match the value for an attribute.  For malformed XML we do+-- our best to guess the programmer's intention.+string             :: LString -> (String,LString)+string ((_,'"') : cs)   = break' ('"' ==) cs++-- Allow attributes to be enclosed between ' '.+string ((_,'\'') : cs)  = break' ('\'' ==) cs++-- Allow attributes that are not enclosed by anything.+string cs           = breakn eos cs+  where eos x = isSpace x || x == '>' || x == '/'+++break' :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])+break' p xs         = let (as,bs) = breakn p xs+                      in (as, case bs of+                                [] -> []+                                _ : cs -> cs)++breakn :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])+breakn p l = (map snd as,bs) where (as,bs) = break (p . snd) l++++decode_attr :: String -> String+decode_attr cs = concatMap cvt (decode_text cs)+  where cvt (TxtBit x) = x+        cvt (CRefBit x) = case cref_to_char x of+                            Just c -> [c]+                            Nothing -> '&' : x ++ ";"++data Txt = TxtBit String | CRefBit String deriving Show++decode_text :: [Char] -> [Txt]+decode_text xs@('&' : cs) = case break (';' ==) cs of+                              (as,_:bs) -> CRefBit as : decode_text bs+                              _ -> [TxtBit xs]+decode_text []  = []+decode_text cs  = let (as,bs) = break ('&' ==) cs+                  in TxtBit as : decode_text bs++cref_to_char :: [Char] -> Maybe Char+cref_to_char cs = case cs of+  '#' : ds  -> num_esc ds+  "lt"      -> Just '<'+  "gt"      -> Just '>'+  "amp"     -> Just '&'+  "apos"    -> Just '\''+  "quot"    -> Just '"'+  _         -> Nothing++num_esc :: String -> Maybe Char+num_esc cs = case cs of+               'x' : ds -> check (readHex ds)+               _        -> check (reads cs)++  where check [(n,"")]  = cvt_char n+        check _         = Nothing++cvt_char :: Int -> Maybe Char+cvt_char x+  | fromEnum (minBound :: Char) <= x && x <= fromEnum (maxBound::Char)+                = Just (toEnum x)+  | otherwise = Nothing++preprocess :: String -> String+preprocess ('\r' : '\n' : cs) = '\n' : preprocess cs+preprocess ('\r' : cs)        = '\n' : preprocess cs+preprocess (c : cs)           = c : preprocess cs+preprocess []                 = []++linenumber :: Line -> String -> LString+linenumber _ [] = []+linenumber n ('\n':s) = n' `seq` ((n,'\n'):linenumber n' s) where n' = n + 1+linenumber n (c:s)    = (n,c) : linenumber n s
+ Text/XML/Light/Output.hs view
@@ -0,0 +1,147 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.XML.Light.Output+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+-- Output handling for the lightweight XML lib.+--++module Text.XML.Light.Output+  ( showTopElement, showContent, showElement, showCData, showQName, showAttr+  , ppTopElement, ppContent, ppElement+  , tagEnd, xml_header+  ) where++import Text.XML.Light.Types+import Data.Char++-- | The XML 1.0 header+xml_header :: String+xml_header = "<?xml version='1.0' ?>"++-- | Pretty printing renders XML documents faithfully,+-- with the exception that whitespace may be added\/removed+-- in non-verbatim character data.+ppTopElement       :: Element -> String+ppTopElement e      = unlines [xml_header,ppElement e]++-- | Pretty printing elements+ppElement          :: Element -> String+ppElement e         = ppElementS "" e ""++-- | Pretty printing content+ppContent          :: Content -> String+ppContent x         = ppContentS "" x ""++-- | Pretty printing content using ShowS+ppContentS         :: String -> Content -> ShowS+ppContentS i x xs   = case x of+                        Elem e -> ppElementS i e xs+                        Text c -> ppCData i c xs+                        CRef r -> showCRefS r xs++ppElementS         :: String -> Element -> ShowS+ppElementS i e xs   = i ++ (tagStart (elName e) (elAttribs e) $+  case elContent e of+    [] -> " />" ++ xs+    [Text t] -> ">" ++ ppCData "" t (tagEnd (elName e) xs)+    cs -> ">\n" ++ foldr ppSub (i ++ tagEnd (elName e) xs) cs+      where ppSub e1 = ppContentS ("  " ++ i) e1 . showChar '\n'+  )++ppCData            :: String -> CData -> ShowS+ppCData i c xs      = i ++ if cdVerbatim c+                              then showCDataS c xs+                              else foldr cons xs (showCData c)++  where cons         :: Char -> String -> String+        cons '\n' ys  = "\n" ++ i ++ ys+        cons y ys     = y : ys++++--------------------------------------------------------------------------------+-- | Adds the <?xml?> header.+showTopElement     :: Element -> String+showTopElement c    = xml_header ++ showElement c++showContent        :: Content -> String+showContent c       = showContentS c ""++showElement        :: Element -> String+showElement c       = showElementS c ""++showCData          :: CData -> String+showCData c         = showCDataS c ""++-- Note: crefs should not contain '&', ';', etc.+showCRefS          :: String -> ShowS+showCRefS r xs      = '&' : r ++ ';' : xs++-- | Good for transmition (no extra white space etc.) but less readable.+showContentS           :: Content -> ShowS+showContentS (Elem e)   = showElementS e+showContentS (Text cs)  = showCDataS cs+showContentS (CRef cs)  = showCRefS cs++-- | Good for transmition (no extra white space etc.) but less readable.+showElementS       :: Element -> ShowS+showElementS e xs =+  tagStart (elName e) (elAttribs e)+    $ case elContent e of+        [] -> " />" ++ xs+        ch -> '>' : foldr showContentS (tagEnd (elName e) xs) ch++-- | Convert a text element to characters.+showCDataS         :: CData -> ShowS+showCDataS cd+ | cdVerbatim cd  = showString "<![CDATA[" . escCData (cdData cd)+                  . showString "]]>"+ | otherwise      = escStr (cdData cd)+++--------------------------------------------------------------------------------+escCData           :: String -> ShowS+escCData (']' : ']' : '>' : cs) = showString "]]]]><![CDATA[>" . escCData cs+escCData (c : cs)               = showChar c . escCData cs+escCData []                     = id++escChar            :: Char -> ShowS+escChar c = case c of+  '<'   -> showString "&lt;"+  '>'   -> showString "&gt;"+  '&'   -> showString "&amp;"+  '"'   -> showString "&quot;"+  '\''  -> showString "&apos;"+  -- XXX: Is this really wortherd?+  -- We could deal with these issues when we convert characters to bytes.+  _ | (oc <= 0x7f && isPrint c) || c == '\n' || c == '\r' -> showChar c+    | otherwise -> showString "&#" . shows oc . showChar ';'+      where oc = ord c++escStr             :: String -> ShowS+escStr cs rs        = foldr escChar rs cs++tagEnd             :: QName -> ShowS+tagEnd qn rs        = '<':'/':showQName qn ++ '>':rs++tagStart           :: QName -> [Attr] -> ShowS+tagStart qn as rs   = '<':showQName qn ++ as_str ++ rs+ where as_str       = if null as then "" else ' ' : unwords (map showAttr as)++showAttr           :: Attr -> String+showAttr (Attr qn v) = showQName qn ++ '=' : '"' : escStr v "\""++showQName          :: QName -> String+showQName q         = pre ++ qName q+  where pre = case qPrefix q of+                Nothing -> ""+                Just p  -> p ++ ":"+++
+ Text/XML/Light/Proc.hs view
@@ -0,0 +1,103 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.XML.Light.Proc+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------+++module Text.XML.Light.Proc where++import Text.XML.Light.Types++import Data.Maybe(listToMaybe)+import Data.List(find)++-- | Get the text value of an XML element.  This function+-- ignores non-text elements, and concatenates all text elements.+strContent         :: Element -> String+strContent e        = concatMap cdData $ onlyText $ elContent e++-- | Select only the elements from a list of XML content.+onlyElems          :: [Content] -> [Element]+onlyElems xs        = [ x | Elem x <- xs ]++-- | Select only the elements from a parent.+elChildren         :: Element -> [Element]+elChildren e        = [ x | Elem x <- elContent e ]++-- | Select only the text from a list of XML content.+onlyText           :: [Content] -> [CData]+onlyText xs         = [ x | Text x <- xs ]++-- | Find all immediate children with the given name.+findChildren       :: QName -> Element -> [Element]+findChildren q e    = filterChildren ((q ==) . elName) e++-- | Filter all immediate children wrt a given predicate.+filterChildren       :: (Element -> Bool) -> Element -> [Element]+filterChildren p e    = filter p (onlyElems (elContent e))+++-- | Filter all immediate children wrt a given predicate over their names.+filterChildrenName      :: (QName -> Bool) -> Element -> [Element]+filterChildrenName p e   = filter (p.elName) (onlyElems (elContent e))+++-- | Find an immediate child with the given name.+findChild          :: QName -> Element -> Maybe Element+findChild q e       = listToMaybe (findChildren q e)++-- | Find an immediate child with the given name.+filterChild          :: (Element -> Bool) -> Element -> Maybe Element+filterChild p e       = listToMaybe (filterChildren p e)++-- | Find an immediate child with name matching a predicate.+filterChildName      :: (QName -> Bool) -> Element -> Maybe Element+filterChildName p e   = listToMaybe (filterChildrenName p e)++-- | Find the left-most occurrence of an element matching given name.+findElement        :: QName -> Element -> Maybe Element+findElement q e     = listToMaybe (findElements q e)++-- | Filter the left-most occurrence of an element wrt. given predicate.+filterElement        :: (Element -> Bool) -> Element -> Maybe Element+filterElement p e     = listToMaybe (filterElements p e)++-- | Filter the left-most occurrence of an element wrt. given predicate.+filterElementName     :: (QName -> Bool) -> Element -> Maybe Element+filterElementName p e  = listToMaybe (filterElementsName p e)++-- | Find all non-nested occurances of an element.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+findElements       :: QName -> Element -> [Element]+findElements qn e = filterElementsName (qn==) e++-- | Find all non-nested occurrences of an element wrt. given predicate.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+filterElements       :: (Element -> Bool) -> Element -> [Element]+filterElements p e+ | p e        = [e]+ | otherwise  = concatMap (filterElements p) $ onlyElems $ elContent e++-- | Find all non-nested occurences of an element wrt a predicate over element names.+-- (i.e., once we have found an element, we do not search+-- for more occurances among the element's children).+filterElementsName       :: (QName -> Bool) -> Element -> [Element]+filterElementsName p e = filterElements (p.elName) e++-- | Lookup the value of an attribute.+findAttr           :: QName -> Element -> Maybe String+findAttr x e        = attrVal `fmap` find ((x ==) . attrKey) (elAttribs e)++-- | Lookup attribute name from list.+lookupAttr           :: QName -> [Attr] -> Maybe String+lookupAttr x as        = attrVal `fmap` find ((x ==) . attrKey) as+
+ Text/XML/Light/Types.hs view
@@ -0,0 +1,85 @@+--------------------------------------------------------------------+-- |+-- Module    : Text.XML.Light.Types+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+-- Basic XML types.+--++module Text.XML.Light.Types where++-- | A line is an Integer+type Line     = Integer++-- | XML content+data Content  = Elem Element+              | Text CData+              | CRef String+                deriving Show++-- | XML elements+data Element  = Element {+                  elName      :: QName,+                  elAttribs   :: [Attr],+                  elContent   :: [Content],+                  elLine      :: Maybe Line+                } deriving Show++-- | XML attributes+data Attr     = Attr {+                  attrKey :: QName,+                  attrVal :: String+                } deriving (Eq,Ord,Show)++-- | XML CData+data CData    = CData {+                  cdVerbatim  :: Bool,+                  cdData      :: String,+                  cdLine      :: Maybe Line+                } deriving Show++-- | XML qualified names+data QName    = QName {+                  qName   :: String,+                  qURI    :: Maybe String,+                  qPrefix :: Maybe String+                } deriving Show+++instance Eq QName where+  q1 == q2  = compare q1 q2 == EQ++instance Ord QName where+  compare q1 q2 =+    case compare (qName q1) (qName q2) of+      EQ  -> case (qURI q1, qURI q2) of+               (Nothing,Nothing) -> compare (qPrefix q1) (qPrefix q2)+               (u1,u2)           -> compare u1 u2+      x   -> x+++-- blank elements --------------------------------------------------------------++-- | Blank names+blank_name :: QName+blank_name = QName { qName = "", qURI = Nothing, qPrefix = Nothing }++-- | Blank cdata+blank_cdata :: CData+blank_cdata = CData { cdVerbatim = False, cdData = "", cdLine = Nothing }++-- | Blank elements+blank_element :: Element+blank_element = Element+                  { elName    = blank_name+                  , elAttribs = []+                  , elContent = []+                  , elLine    = Nothing+                  }++
+ xml.cabal view
@@ -0,0 +1,20 @@+Name:            xml+Version:         1.2.6+Homepage:        http://galois.com+Synopsis:        A simple XML library.+Description:     A simple XML library.+Category:        Text, XML+License:         BSD3+License-File:    LICENSE+Author:          Galois Inc.+Maintainer:      diatchki@galois.com+Copyright:       (c) 2007-2008 Galois Inc.+Build-depends:   base+Ghc-options:     -Wall -O2+Exposed-modules: Text.XML.Light,+                 Text.XML.Light.Types,+                 Text.XML.Light.Output,+                 Text.XML.Light.Input,+                 Text.XML.Light.Proc+Extensions:      FlexibleInstances+Build-type:      Simple