-- hexpat, a Haskell wrapper for expat
-- Copyright (C) 2008 Evan Martin <martine@danga.com>
-- Copyright (C) 2009 Stephen Blackheath <http://blacksapphire.com/antispam>

-- | In the default representation, qualified tag and attribute names such as
-- \<abc:hello\> are represented just as a string containing a colon, e.g.
-- \"abc:hello\".
--
-- This module provides functionality to handle these more intelligently, splitting
-- all tag and attribute names into their Prefix and LocalPart components.

module Text.XML.Expat.Internal.Qualified (
        QName(..),
        QAttributes,
        mkQName,
        mkAnQName,
        toQualified,
        fromQualified
    ) where

import Text.XML.Expat.Internal.NodeClass
import Text.XML.Expat.SAX
import Control.DeepSeq
import Data.Monoid

-- | A qualified name.
--
-- Qualified names have two parts, a prefix and a local part. The local part
-- is the name of the tag. The prefix scopes that name to a particular
-- group of legal tags.
--
-- The prefix will usually be associated with a namespace URI. This is usually
-- achieved by using xmlns attributes to bind prefixes to URIs.
data QName text =
    QName {
        forall text. QName text -> Maybe text
qnPrefix    :: Maybe text,
        forall text. QName text -> text
qnLocalPart :: !text
    }
    deriving (QName text -> QName text -> Bool
(QName text -> QName text -> Bool)
-> (QName text -> QName text -> Bool) -> Eq (QName text)
forall text. Eq text => QName text -> QName text -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall text. Eq text => QName text -> QName text -> Bool
== :: QName text -> QName text -> Bool
$c/= :: forall text. Eq text => QName text -> QName text -> Bool
/= :: QName text -> QName text -> Bool
Eq,Int -> QName text -> ShowS
[QName text] -> ShowS
QName text -> String
(Int -> QName text -> ShowS)
-> (QName text -> String)
-> ([QName text] -> ShowS)
-> Show (QName text)
forall text. Show text => Int -> QName text -> ShowS
forall text. Show text => [QName text] -> ShowS
forall text. Show text => QName text -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall text. Show text => Int -> QName text -> ShowS
showsPrec :: Int -> QName text -> ShowS
$cshow :: forall text. Show text => QName text -> String
show :: QName text -> String
$cshowList :: forall text. Show text => [QName text] -> ShowS
showList :: [QName text] -> ShowS
Show)

instance NFData text => NFData (QName text) where
    rnf :: QName text -> ()
rnf (QName Maybe text
pre text
loc) = (Maybe text, text) -> ()
forall a. NFData a => a -> ()
rnf (Maybe text
pre, text
loc)

-- | Type shortcut for attributes with qualified names
type QAttributes text = Attributes (QName text) text

-- | Make a new QName from a prefix and localPart.
mkQName :: text -> text -> QName text
mkQName :: forall text. text -> text -> QName text
mkQName text
prefix text
localPart = Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName (text -> Maybe text
forall a. a -> Maybe a
Just text
prefix) text
localPart

-- | Make a new QName with no prefix.
mkAnQName :: text -> QName text
mkAnQName :: forall text. text -> QName text
mkAnQName text
localPart = Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName Maybe text
forall a. Maybe a
Nothing text
localPart

toQualified :: (NodeClass n c, GenericXMLString text) => n c text text -> n c (QName text) text
toQualified :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text) =>
n c text text -> n c (QName text) text
toQualified = (text -> QName text) -> n c text text -> n c (QName text) text
forall tag tag' text.
(tag -> tag') -> n c tag text -> n c tag' text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag tag' text.
NodeClass n c =>
(tag -> tag') -> n c tag text -> n c tag' text
mapAllTags text -> QName text
forall {text}. GenericXMLString text => text -> QName text
qual
  where
    qual :: text -> QName text
qual text
ident =
        case Char -> text -> (text, text)
forall s. GenericXMLString s => Char -> s -> (s, s)
gxBreakOn Char
':' text
ident of
             (text
prefix, text
_local) | Bool -> Bool
not (text -> Bool
forall s. GenericXMLString s => s -> Bool
gxNullString text
_local)
                              Bool -> Bool -> Bool
&& text -> Char
forall s. GenericXMLString s => s -> Char
gxHead text
_local Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
                                 -> Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName (text -> Maybe text
forall a. a -> Maybe a
Just text
prefix) (text -> text
forall s. GenericXMLString s => s -> s
gxTail text
_local)
             (text, text)
_                   -> Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName Maybe text
forall a. Maybe a
Nothing text
ident

fromQualified :: (NodeClass n c, GenericXMLString text) => n c (QName text) text -> n c text text
fromQualified :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text) =>
n c (QName text) text -> n c text text
fromQualified = (QName text -> text) -> n c (QName text) text -> n c text text
forall tag tag' text.
(tag -> tag') -> n c tag text -> n c tag' text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag tag' text.
NodeClass n c =>
(tag -> tag') -> n c tag text -> n c tag' text
mapAllTags QName text -> text
forall {a}. GenericXMLString a => QName a -> a
tag
  where
    tag :: QName a -> a
tag (QName (Just a
prefix) a
local) = a
prefix a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` Char -> a
forall s. GenericXMLString s => Char -> s
gxFromChar Char
':' a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
local
    tag (QName Maybe a
Nothing       a
local) = a
local