~singpolyma/xml-types-haskell

64470ec69de1232f692f5cb9ff9a70cc8c067f83 — Yitzchak Gale 9 years ago f698fe6
Add NFData instances to types.
2 files changed, 48 insertions(+), 0 deletions(-)

M lib/Data/XML/Types.hs
M xml-types.cabal
M lib/Data/XML/Types.hs => lib/Data/XML/Types.hs +47 -0
@@ 76,6 76,7 @@ import           Data.String (IsString, fromString)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Typeable (Typeable)
import           Control.DeepSeq (NFData(rnf))

data Document = Document
	{ documentPrologue :: Prologue


@@ 84,6 85,9 @@ data Document = Document
	}
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Document where
	rnf (Document a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()

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


@@ 91,17 95,27 @@ data Prologue = Prologue
	}
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Prologue where
	rnf (Prologue a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()

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

instance NFData Instruction where
	rnf (Instruction a b) = rnf a `seq` rnf b `seq` ()

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

instance NFData Miscellaneous where
	rnf (MiscInstruction a) = rnf a `seq` ()
	rnf (MiscComment a)     = rnf a `seq` ()

data Node
	= NodeElement Element
	| NodeInstruction Instruction


@@ 109,6 123,12 @@ data Node
	| NodeComment Text
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Node where
	rnf (NodeElement a)     = rnf a `seq` ()
	rnf (NodeInstruction a) = rnf a `seq` ()
	rnf (NodeContent a)     = rnf a `seq` ()
	rnf (NodeComment a)     = rnf a `seq` ()

data Element = Element
	{ elementName :: Name
	, elementAttributes :: [(Name, [Content])]


@@ 116,11 136,18 @@ data Element = Element
	}
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Element where
	rnf (Element a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()

data Content
	= ContentText Text
	| ContentEntity Text -- ^ For pass-through parsing
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Content where
	rnf (ContentText a)   = rnf a `seq` ()
	rnf (ContentEntity a) = rnf a `seq` ()

-- | A fully qualified name.
--
-- Prefixes are not semantically important; they are included only to


@@ 156,6 183,9 @@ instance IsString Name where
		(ns, local) -> Name (T.pack (drop 1 local)) (Just (T.pack ns)) Nothing
	fromString local = Name (T.pack local) Nothing Nothing

instance NFData Name where
	rnf (Name a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()

-- | Note: due to the incredible complexity of DTDs, this type only supports
-- external subsets. I've tried adding internal subset types, but they
-- quickly gain more code than the rest of this module put together.


@@ 168,11 198,18 @@ data Doctype = Doctype
	}
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Doctype where
	rnf (Doctype a b) = rnf a `seq` rnf b `seq` ()

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

instance NFData ExternalID where
	rnf (SystemID a)   = rnf a `seq` ()
	rnf (PublicID a b) = rnf a `seq` rnf b `seq` ()

-- | 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
-- specified as a sequence of events.


@@ 198,6 235,16 @@ data Event
	| EventCDATA Text
	deriving (Data, Eq, Ord, Show, Typeable)

instance NFData Event where
	rnf (EventBeginDoctype a b) = rnf a `seq` rnf b `seq` ()
	rnf (EventInstruction a)    = rnf a `seq` ()
	rnf (EventBeginElement a b) = rnf a `seq` rnf b `seq` ()
	rnf (EventEndElement a)     = rnf a `seq` ()
	rnf (EventContent a)        = rnf a `seq` ()
	rnf (EventComment a)        = rnf a `seq` ()
	rnf (EventCDATA a)          = rnf a `seq` ()
	rnf _                       = ()

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

M xml-types.cabal => xml-types.cabal +1 -0
@@ 27,6 27,7 @@ library

  build-depends:
      base >= 3.0 && < 5.0
    , deepseq >= 1.1.0.0
    , text

  exposed-modules: