~singpolyma/xml-types-haskell

bd358272aabcf88db51cd22a5ca25215a8cedddd — John Millikin 11 years ago 39362be
Instance ``Typeable`` for all types
1 files changed, 45 insertions(+), 0 deletions(-)

M Data/XML/Types.hs
M Data/XML/Types.hs => Data/XML/Types.hs +45 -0
@@ 77,6 77,8 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.String (IsString, fromString)
import Data.Function (on)
import Data.Typeable ( Typeable, TypeRep, typeOf
                     , mkTyConApp, mkTyCon)

data Document = Document
	{ documentPrologue :: Prologue


@@ 85,6 87,9 @@ data Document = Document
	}
	deriving (Show, Eq)

instance Typeable Document where
	typeOf = typeString "Document"

data Prologue = Prologue
	{ prologueBefore :: [Miscellaneous]
	, prologueDoctype :: Maybe Doctype


@@ 92,17 97,26 @@ data Prologue = Prologue
	}
	deriving (Show, Eq)

instance Typeable Prologue where
	typeOf = typeString "Prologue"

data Instruction = Instruction
	{ instructionTarget :: Text
	, instructionData :: Text
	}
	deriving (Show, Eq, Ord)

instance Typeable Instruction where
	typeOf = typeString "Instruction"

data Miscellaneous
	= MiscInstruction Instruction
	| MiscComment Text
	deriving (Show, Eq)

instance Typeable Miscellaneous where
	typeOf = typeString "Miscellaneous"

data Node
	= NodeElement Element
	| NodeInstruction Instruction


@@ 110,6 124,9 @@ data Node
	| NodeComment Text
	deriving (Show, Eq)

instance Typeable Node where
	typeOf = typeString "Node"

data Element = Element
	{ elementName :: Name
	, elementAttributes :: M.Map Name [Content]


@@ 117,11 134,17 @@ data Element = Element
	}
	deriving (Show, Eq)

instance Typeable Element where
	typeOf = typeString "Element"

data Content
	= ContentText Text
	| ContentEntity Text
	deriving (Show, Eq)

instance Typeable Content where
	typeOf = typeString "Content"

data Name = Name
	{ nameLocalName :: Text
	, nameNamespace :: Maybe Text


@@ 129,6 152,9 @@ data Name = Name
	}
	deriving (Show)

instance Typeable Name where
	typeOf = typeString "Name"

-- | Ignores prefixes
instance Eq Name where
	(==) = (==) `on` (\x -> (nameNamespace x, nameLocalName x))


@@ 160,17 186,26 @@ data Doctype = Doctype
instance Ord Doctype where
	compare = compare `on` (\x -> (doctypeName x, doctypeExternalID x))

instance Typeable Doctype where
	typeOf = typeString "Doctype"

data ExternalID
	= SystemID Text
	| PublicID Text Text
	deriving (Show, Eq, Ord)

instance Typeable ExternalID where
	typeOf = typeString "ExternalID"

data DoctypeNode
	= DoctypeDeclaration Declaration
	| DoctypeInstruction Instruction
	| DoctypeComment Text
	deriving (Show, Eq)

instance Typeable DoctypeNode where
	typeOf = typeString "DoctypeNode"

-- TODO
data Declaration
	= DeclareElement Text


@@ 179,6 214,9 @@ data Declaration
	| DeclareNotation Text
	deriving (Show, Eq)

instance Typeable Declaration where
	typeOf = typeString "Declaration"

-- | Some XML processing tools are incremental, and work in terms of events
-- rather than node trees. Defining the event type here, even though it won't
-- be useful to most users, allows these packages to interoperate more easily.


@@ 198,6 236,9 @@ data Event
	| EventCDATA Text
	deriving (Show, Eq)

instance Typeable Event where
	typeOf = typeString "Event"

isElement :: Node -> [Element]
isElement (NodeElement e) = [e]
isElement _ = []


@@ 252,3 293,7 @@ contentText :: [Content] -> Text
contentText = T.concat . map step where
	step (ContentText t) = t
	step (ContentEntity entity) = T.concat [T.pack "&", entity, T.pack ";"]

typeString :: String -> a -> TypeRep
typeString str _ = mkTyConApp (mkTyCon ("Data.XML.Types." ++ str)) []