@@ 1,3 1,5 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
-- |
-- Module: Data.XML.Types
-- Copyright: 2010-2011 John Millikin
@@ 65,79 67,58 @@ module Data.XML.Types
, attributeContent
, attributeText
) where
-import Control.Monad ((>=>))
-import Data.Maybe (isJust)
-import Data.Text (Text)
+
+import Control.Monad ((>=>))
+import Data.Maybe (isJust)
+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)
+import Data.String (IsString, fromString)
+import Data.Function (on)
+import Data.Typeable (Typeable)
data Document = Document
{ documentPrologue :: Prologue
, documentRoot :: Element
, documentEpilogue :: [Miscellaneous]
}
- deriving (Show, Eq, Ord)
-
-instance Typeable Document where
- typeOf = typeString "Document"
+ deriving (Show, Eq, Ord, Typeable)
data Prologue = Prologue
{ prologueBefore :: [Miscellaneous]
, prologueDoctype :: Maybe Doctype
, prologueAfter :: [Miscellaneous]
}
- deriving (Show, Eq, Ord)
-
-instance Typeable Prologue where
- typeOf = typeString "Prologue"
+ deriving (Show, Eq, Ord, Typeable)
data Instruction = Instruction
{ instructionTarget :: Text
, instructionData :: Text
}
- deriving (Show, Eq, Ord)
-
-instance Typeable Instruction where
- typeOf = typeString "Instruction"
+ deriving (Show, Eq, Ord, Typeable)
data Miscellaneous
= MiscInstruction Instruction
| MiscComment Text
- deriving (Show, Eq, Ord)
-
-instance Typeable Miscellaneous where
- typeOf = typeString "Miscellaneous"
+ deriving (Show, Eq, Ord, Typeable)
data Node
= NodeElement Element
| NodeInstruction Instruction
| NodeContent Content
| NodeComment Text
- deriving (Show, Eq, Ord)
-
-instance Typeable Node where
- typeOf = typeString "Node"
+ deriving (Show, Eq, Ord, Typeable)
data Element = Element
{ elementName :: Name
, elementAttributes :: [(Name, [Content])]
, elementNodes :: [Node]
}
- deriving (Show, Eq, Ord)
-
-instance Typeable Element where
- typeOf = typeString "Element"
+ deriving (Show, Eq, Ord, Typeable)
data Content
= ContentText Text
| ContentEntity Text -- ^ For pass-through parsing
- deriving (Show, Eq, Ord)
-
-instance Typeable Content where
- typeOf = typeString "Content"
+ deriving (Show, Eq, Ord, Typeable)
-- | A fully qualified name.
--
@@ 159,10 140,7 @@ data Name = Name
, nameNamespace :: Maybe Text
, namePrefix :: Maybe Text
}
- deriving (Show)
-
-instance Typeable Name where
- typeOf = typeString "Name"
+ deriving (Show, Typeable)
instance Eq Name where
(==) = (==) `on` (\x -> (nameNamespace x, nameLocalName x))
@@ 187,18 165,12 @@ data Doctype = Doctype
{ doctypeName :: Text
, doctypeID :: Maybe ExternalID
}
- deriving (Show, Eq, Ord)
-
-instance Typeable Doctype where
- typeOf = typeString "Doctype"
+ deriving (Show, Eq, Ord, Typeable)
data ExternalID
= SystemID Text
| PublicID Text Text
- deriving (Show, Eq, Ord)
-
-instance Typeable ExternalID where
- typeOf = typeString "ExternalID"
+ deriving (Show, Eq, Ord, Typeable)
-- | Some XML processing tools are incremental, and work in terms of events
-- rather than node trees. The 'Event' type allows a document to be fully
@@ 223,10 195,7 @@ data Event
| EventContent Content
| EventComment Text
| EventCDATA Text
- deriving (Show, Eq, Ord)
-
-instance Typeable Event where
- typeOf = typeString "Event"
+ deriving (Show, Eq, Ord, Typeable)
isElement :: Node -> [Element]
isElement (NodeElement e) = [e]
@@ 283,6 252,3 @@ contentText (ContentEntity entity) = [T.pack "&", entity, T.pack ";"]
contentFlat :: [Content] -> Text
contentFlat cs = T.concat (cs >>= contentText)
-
-typeString :: String -> a -> TypeRep
-typeString str _ = mkTyConApp (mkTyCon ("Data.XML.Types." ++ str)) []