@@ 1,7 1,10 @@
{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
--- if impl(ghc >= 7.2):
--- extensions: DeriveGeneric, StandaloneDeriving
+#if MIN_VERSION_base(4,4,0)
+{-# LANGUAGE DeriveGeneric #-}
+#endif
+#endif
-- |
-- Module: Data.XML.Types
@@ 69,79 72,101 @@ module Data.XML.Types
) where
import Control.Monad ((>=>))
-import Data.Data (Data)
import Data.Function (on)
import Data.Maybe (isJust)
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T
-import Data.Typeable (Typeable)
import Control.DeepSeq (NFData(rnf))
+#if __GLASGOW_HASKELL__
+import Data.Typeable (Typeable)
+import Data.Data (Data)
+
#if MIN_VERSION_base(4,4,0)
import GHC.Generics (Generic)
#endif
+#endif
data Document = Document
{ documentPrologue :: Prologue
, documentRoot :: Element
, documentEpilogue :: [Miscellaneous]
}
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Document where
rnf (Document a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Document
-#endif
-
data Prologue = Prologue
{ prologueBefore :: [Miscellaneous]
, prologueDoctype :: Maybe Doctype
, prologueAfter :: [Miscellaneous]
}
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Prologue where
rnf (Prologue a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Prologue
-#endif
-
data Instruction = Instruction
{ instructionTarget :: Text
, instructionData :: Text
}
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Instruction where
rnf (Instruction a b) = rnf a `seq` rnf b `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Instruction
-#endif
-
data Miscellaneous
= MiscInstruction Instruction
| MiscComment Text
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Miscellaneous where
rnf (MiscInstruction a) = rnf a `seq` ()
rnf (MiscComment a) = rnf a `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Miscellaneous
-#endif
-
data Node
= NodeElement Element
| NodeInstruction Instruction
| NodeContent Content
| NodeComment Text
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Node where
rnf (NodeElement a) = rnf a `seq` ()
@@ 149,36 174,40 @@ instance NFData Node where
rnf (NodeContent a) = rnf a `seq` ()
rnf (NodeComment a) = rnf a `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Node
-#endif
data Element = Element
{ elementName :: Name
, elementAttributes :: [(Name, [Content])]
, elementNodes :: [Node]
}
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Element where
rnf (Element a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Element
-#endif
-
data Content
= ContentText Text
| ContentEntity Text -- ^ For pass-through parsing
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Content where
rnf (ContentText a) = rnf a `seq` ()
rnf (ContentEntity a) = rnf a `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Content
-#endif
-- | A fully qualified name.
--
@@ 200,7 229,14 @@ data Name = Name
, nameNamespace :: Maybe Text
, namePrefix :: Maybe Text
}
- deriving (Data, Show, Typeable)
+ deriving (Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance Eq Name where
(==) = (==) `on` (\x -> (nameNamespace x, nameLocalName x))
@@ 218,10 254,6 @@ instance IsString Name where
instance NFData Name where
rnf (Name a b c) = rnf a `seq` rnf b `seq` rnf c `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Name
-#endif
-
-- | 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.
@@ 232,28 264,34 @@ data Doctype = Doctype
{ doctypeName :: Text
, doctypeID :: Maybe ExternalID
}
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Doctype where
rnf (Doctype a b) = rnf a `seq` rnf b `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Doctype
-#endif
-
data ExternalID
= SystemID Text
| PublicID Text Text
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData ExternalID where
rnf (SystemID a) = rnf a `seq` ()
rnf (PublicID a b) = rnf a `seq` rnf b `seq` ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic ExternalID
-#endif
-
-- | 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.
@@ 277,7 315,14 @@ data Event
| EventContent Content
| EventComment Text
| EventCDATA Text
- deriving (Data, Eq, Ord, Show, Typeable)
+ deriving (Eq, Ord, Show
+#if __GLASGOW_HASKELL__
+ , Data, Typeable
+#if MIN_VERSION_base(4,4,0)
+ , Generic
+#endif
+#endif
+ )
instance NFData Event where
rnf (EventBeginDoctype a b) = rnf a `seq` rnf b `seq` ()
@@ 289,10 334,6 @@ instance NFData Event where
rnf (EventCDATA a) = rnf a `seq` ()
rnf _ = ()
-#if MIN_VERSION_base(4,4,0)
-deriving instance Generic Event
-#endif
-
isElement :: Node -> [Element]
isElement (NodeElement e) = [e]
isElement _ = []