{- |
We provide a type class for tag and attribute names.
Instances can be names that preserve case,
names with lowercase letters as canonical representation.
-}
module Text.XML.Basic.Name where

-- * types and classes

class Ord name => C name where
   fromString :: String -> name
   toString :: name -> String


{- |
We need to distinguish between tag names and attribute names,
because DOCTYPE as tag name must be written upper case,
whereas as attribute name it may be written either way.
-}
class Ord ident => Tag ident where
   tagFromString :: String -> ident
   tagToString :: ident -> String

class Ord ident => Attribute ident where
   attributeFromString :: String -> ident
   attributeToString :: ident -> String



-- * convenience functions

match :: (C name) => String -> name -> Bool
match :: forall name. C name => String -> name -> Bool
match String
proto = (forall name. C name => String -> name
fromString String
proto forall a. Eq a => a -> a -> Bool
==)

matchAny :: (C name) => [String] -> name -> Bool
matchAny :: forall name. C name => [String] -> name -> Bool
matchAny [String]
proto = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (forall a b. (a -> b) -> [a] -> [b]
map forall name. C name => String -> name
fromString [String]
proto)