    --------------------------------------------------------------------
    -- |
    -- Module    : Text.XML.Light.Input
    -- Copyright : (c) Galois, Inc. 2007
    -- License   : BSD3
    --
    -- Maintainer: Iavor S. Diatchki <diatchki@galois.com>
    -- Stability : provisional
    -- Portability: portable
    --
    -- Lightweight XML parsing
    --

    module Text.XML.Light.Input (parseXML,parseXMLDoc) where

    import Text.XML.Light.Lexer
    import Text.XML.Light.Types
    import Text.XML.Light.Proc
    import Text.XML.Light.Output(tagEnd)

    import Data.List(isPrefixOf)

    -- | parseXMLDoc, parse a XMLl document to maybe an element
    parseXMLDoc  :: XmlSource s => s -> Maybe Element
    parseXMLDoc :: forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc s
    xs  = [Content] -> Maybe Element
    strip (s -> [Content]
    forall s. XmlSource s => s -> [Content]
    parseXML s
    xs)
      where strip :: [Content] -> Maybe Element
    strip [Content]
    cs = case [Content] -> [Element]
    onlyElems [Content]
    cs of
                        Element
    e : [Element]
    es
                          | String
    "?xml" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` QName -> String
    qName (Element -> QName
    elName Element
    e)
                              -> [Content] -> Maybe Element
    strip ((Element -> Content) -> [Element] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Content
    Elem [Element]
    es)
                          | Bool
    otherwise -> Element -> Maybe Element
    forall a. a -> Maybe a
    Just Element
    e
                        [Element]
    _ -> Maybe Element
    forall a. Maybe a
    Nothing

    -- | parseXML to a list of content chunks
    parseXML :: XmlSource s => s -> [Content]
    parseXML :: forall s. XmlSource s => s -> [Content]
    parseXML  = [Token] -> [Content]
    parse ([Token] -> [Content]) -> (s -> [Token]) -> s -> [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> [Token]
    forall source. XmlSource source => source -> [Token]
    tokens

    ------------------------------------------------------------------------

    parse      :: [Token] -> [Content]
    parse :: [Token] -> [Content]
    parse []    = []
    parse [Token]
    ts    = let ([Content]
    es,[QName]
    _,[Token]
    ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes ([],Maybe String
    forall a. Maybe a
    Nothing) [] [Token]
    ts
                  in [Content]
    es [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Token] -> [Content]
    parse [Token]
    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 :: NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    ns [QName]
    ps (TokCRef String
    ref : [Token]
    ts) =
      let ([Content]
    es,[QName]
    qs,[Token]
    ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    ns [QName]
    ps [Token]
    ts
      in (String -> Content
    CRef String
    ref Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    es, [QName]
    qs, [Token]
    ts1)

    nodes NSInfo
    ns [QName]
    ps (TokText CData
    txt : [Token]
    ts) =
      let ([Content]
    es,[QName]
    qs,[Token]
    ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    ns [QName]
    ps [Token]
    ts
          (String
    more,[Content]
    es1)  = case [Content]
    es of
                          Text CData
    cd : [Content]
    es1'
                            | CData -> CDataKind
    cdVerbatim CData
    cd CDataKind -> CDataKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == CData -> CDataKind
    cdVerbatim CData
    txt -> (CData -> String
    cdData CData
    cd,[Content]
    es1')
                          [Content]
    _                                   -> ([],[Content]
    es)

      in (CData -> Content
    Text CData
    txt { cdData :: String
    cdData = CData -> String
    cdData CData
    txt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    more } Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    es1, [QName]
    qs, [Token]
    ts1)

    nodes NSInfo
    cur_info [QName]
    ps (TokStart Line
    p QName
    t [Attr]
    as Bool
    empty : [Token]
    ts) = (Content
    node Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    siblings, [QName]
    open, [Token]
    toks)
      where
      new_name :: QName
    new_name  = NSInfo -> QName -> QName
    annotName NSInfo
    new_info QName
    t
      new_info :: NSInfo
    new_info  = (Attr -> NSInfo -> NSInfo) -> NSInfo -> [Attr] -> NSInfo
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Attr -> NSInfo -> NSInfo
    addNS NSInfo
    cur_info [Attr]
    as
      node :: Content
    node      = Element -> Content
    Elem Element { elLine :: Maybe Line
    elLine    = Line -> Maybe Line
    forall a. a -> Maybe a
    Just Line
    p
                               , elName :: QName
    elName    = QName
    new_name
                               , elAttribs :: [Attr]
    elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map (NSInfo -> Attr -> Attr
    annotAttr NSInfo
    new_info) [Attr]
    as
                               , elContent :: [Content]
    elContent = [Content]
    children
                               }

      ([Content]
    children,([Content]
    siblings,[QName]
    open,[Token]
    toks))
        | Bool
    empty     = ([], NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    cur_info [QName]
    ps [Token]
    ts)
        | Bool
    otherwise = let ([Content]
    es1,[QName]
    qs1,[Token]
    ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    new_info (QName
    new_nameQName -> [QName] -> [QName]
    forall a. a -> [a] -> [a]
    :[QName]
    ps) [Token]
    ts
                      in ([Content]
    es1,
                          case [QName]
    qs1 of
                            [] -> NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    cur_info [QName]
    ps [Token]
    ts1
                            QName
    _ : [QName]
    qs3 -> ([],[QName]
    qs3,[Token]
    ts1))

    nodes NSInfo
    ns [QName]
    ps (TokEnd Line
    p QName
    t : [Token]
    ts)   = let t1 :: QName
    t1 = NSInfo -> QName -> QName
    annotName NSInfo
    ns QName
    t
                                    in case (QName -> Bool) -> [QName] -> ([QName], [QName])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (QName
    t1 QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) [QName]
    ps of
                                      ([QName]
    as,QName
    _:[QName]
    _) -> ([],[QName]
    as,[Token]
    ts)
                                      -- Unknown closing tag. Insert as text.
                                      ([QName]
    _,[]) ->
                                        let ([Content]
    es,[QName]
    qs,[Token]
    ts1) = NSInfo -> [QName] -> [Token] -> ([Content], [QName], [Token])
    nodes NSInfo
    ns [QName]
    ps [Token]
    ts
                                        in (CData -> Content
    Text CData {
                                                   cdLine :: Maybe Line
    cdLine = Line -> Maybe Line
    forall a. a -> Maybe a
    Just Line
    p,
                                                   cdVerbatim :: CDataKind
    cdVerbatim = CDataKind
    CDataText,
                                                   cdData :: String
    cdData = QName -> String -> String
    tagEnd QName
    t String
    ""
                                                  } Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    es,[QName]
    qs, [Token]
    ts1)

    nodes NSInfo
    _ [QName]
    ps []                 = ([],[QName]
    ps,[])

    annotName :: NSInfo -> QName -> QName
    annotName :: NSInfo -> QName -> QName
    annotName ([(String, String)]
    namespaces,Maybe String
    def_ns) QName
    n =
      QName
    n { qURI :: Maybe String
    qURI = Maybe String
    -> (String -> Maybe String) -> Maybe String -> Maybe String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe String
    def_ns (String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `lookup` [(String, String)]
    namespaces) (QName -> Maybe String
    qPrefix QName
    n) }

    annotAttr :: NSInfo -> Attr -> Attr
    annotAttr :: NSInfo -> Attr -> Attr
    annotAttr NSInfo
    ns a :: Attr
    a@(Attr { attrKey :: Attr -> QName
    attrKey = QName
    k}) =
      case (QName -> Maybe String
    qPrefix QName
    k, QName -> String
    qName QName
    k) of
        -- Do not apply the default name-space to unqualified
        -- attributes.  See Section 6.2 of <http://www.w3.org/TR/REC-xml-names>.
        (Maybe String
    Nothing, String
    _)      -> Attr
    a
        (Maybe String, String)
    _                 -> Attr
    a { attrKey :: QName
    attrKey = NSInfo -> QName -> QName
    annotName NSInfo
    ns QName
    k }

    addNS :: Attr -> NSInfo -> NSInfo
    addNS :: Attr -> NSInfo -> NSInfo
    addNS (Attr { attrKey :: Attr -> QName
    attrKey = QName
    key, attrVal :: Attr -> String
    attrVal = String
    val }) ([(String, String)]
    ns,Maybe String
    def) =
      case (QName -> Maybe String
    qPrefix QName
    key, QName -> String
    qName QName
    key) of
        (Maybe String
    Nothing,String
    "xmlns") -> ([(String, String)]
    ns, if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    val then Maybe String
    forall a. Maybe a
    Nothing else String -> Maybe String
    forall a. a -> Maybe a
    Just String
    val)
        (Just String
    "xmlns", String
    k) -> ((String
    k, String
    val) (String, String) -> [(String, String)] -> [(String, String)]
    forall a. a -> [a] -> [a]
    : [(String, String)]
    ns, Maybe String
    def)
        (Maybe String, String)
    _                 -> ([(String, String)]
    ns,Maybe String
    def)