{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable #-}
#if MIN_VERSION_base(4,4,0)
{-# LANGUAGE DeriveGeneric #-}
#endif
#endif
module Data.XML.Types
(
Document (..)
, Prologue (..)
, Instruction (..)
, Miscellaneous (..)
, Node (..)
, Element (..)
, Content (..)
, Name (..)
, Doctype (..)
, ExternalID (..)
, Event (..)
, isElement
, isInstruction
, isContent
, isComment
, isNamed
, elementChildren
, elementContent
, elementText
, nodeChildren
, nodeContent
, nodeText
, hasAttribute
, hasAttributeText
, attributeContent
, attributeText
) where
import Control.Monad ((>=>))
import Data.Function (on)
import Data.Maybe (isJust)
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as T
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
{ Document -> Prologue
documentPrologue :: Prologue
, Document -> Element
documentRoot :: Element
, Document -> [Miscellaneous]
documentEpilogue :: [Miscellaneous]
}
deriving (Document -> Document -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Eq, Eq Document
Document -> Document -> Bool
Document -> Document -> Ordering
Document -> Document -> Document
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Document -> Document -> Document
$cmin :: Document -> Document -> Document
max :: Document -> Document -> Document
$cmax :: Document -> Document -> Document
>= :: Document -> Document -> Bool
$c>= :: Document -> Document -> Bool
> :: Document -> Document -> Bool
$c> :: Document -> Document -> Bool
<= :: Document -> Document -> Bool
$c<= :: Document -> Document -> Bool
< :: Document -> Document -> Bool
$c< :: Document -> Document -> Bool
compare :: Document -> Document -> Ordering
$ccompare :: Document -> Document -> Ordering
Ord, Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Document
Document -> Constr
Document -> DataType
(forall b. Data b => b -> b) -> Document -> Document
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
forall u. (forall d. Data d => d -> u) -> Document -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Document -> m Document
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Document -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Document -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Document -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Document -> r
gmapT :: (forall b. Data b => b -> b) -> Document -> Document
$cgmapT :: (forall b. Data b => b -> b) -> Document -> Document
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Document)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Document)
dataTypeOf :: Document -> DataType
$cdataTypeOf :: Document -> DataType
toConstr :: Document -> Constr
$ctoConstr :: Document -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Document
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Document -> c Document
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Document x -> Document
$cfrom :: forall x. Document -> Rep Document x
Generic
#endif
#endif
)
instance NFData Document where
rnf :: Document -> ()
rnf (Document Prologue
a Element
b [Miscellaneous]
c) = forall a. NFData a => a -> ()
rnf Prologue
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Element
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Miscellaneous]
c seq :: forall a b. a -> b -> b
`seq` ()
data Prologue = Prologue
{ Prologue -> [Miscellaneous]
prologueBefore :: [Miscellaneous]
, Prologue -> Maybe Doctype
prologueDoctype :: Maybe Doctype
, Prologue -> [Miscellaneous]
prologueAfter :: [Miscellaneous]
}
deriving (Prologue -> Prologue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prologue -> Prologue -> Bool
$c/= :: Prologue -> Prologue -> Bool
== :: Prologue -> Prologue -> Bool
$c== :: Prologue -> Prologue -> Bool
Eq, Eq Prologue
Prologue -> Prologue -> Bool
Prologue -> Prologue -> Ordering
Prologue -> Prologue -> Prologue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Prologue -> Prologue -> Prologue
$cmin :: Prologue -> Prologue -> Prologue
max :: Prologue -> Prologue -> Prologue
$cmax :: Prologue -> Prologue -> Prologue
>= :: Prologue -> Prologue -> Bool
$c>= :: Prologue -> Prologue -> Bool
> :: Prologue -> Prologue -> Bool
$c> :: Prologue -> Prologue -> Bool
<= :: Prologue -> Prologue -> Bool
$c<= :: Prologue -> Prologue -> Bool
< :: Prologue -> Prologue -> Bool
$c< :: Prologue -> Prologue -> Bool
compare :: Prologue -> Prologue -> Ordering
$ccompare :: Prologue -> Prologue -> Ordering
Ord, Int -> Prologue -> ShowS
[Prologue] -> ShowS
Prologue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prologue] -> ShowS
$cshowList :: [Prologue] -> ShowS
show :: Prologue -> String
$cshow :: Prologue -> String
showsPrec :: Int -> Prologue -> ShowS
$cshowsPrec :: Int -> Prologue -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Prologue
Prologue -> Constr
Prologue -> DataType
(forall b. Data b => b -> b) -> Prologue -> Prologue
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Prologue -> u
forall u. (forall d. Data d => d -> u) -> Prologue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prologue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prologue -> c Prologue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prologue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prologue)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Prologue -> m Prologue
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prologue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Prologue -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Prologue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Prologue -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Prologue -> r
gmapT :: (forall b. Data b => b -> b) -> Prologue -> Prologue
$cgmapT :: (forall b. Data b => b -> b) -> Prologue -> Prologue
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prologue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Prologue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prologue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Prologue)
dataTypeOf :: Prologue -> DataType
$cdataTypeOf :: Prologue -> DataType
toConstr :: Prologue -> Constr
$ctoConstr :: Prologue -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prologue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Prologue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prologue -> c Prologue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Prologue -> c Prologue
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Prologue x -> Prologue
forall x. Prologue -> Rep Prologue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prologue x -> Prologue
$cfrom :: forall x. Prologue -> Rep Prologue x
Generic
#endif
#endif
)
instance NFData Prologue where
rnf :: Prologue -> ()
rnf (Prologue [Miscellaneous]
a Maybe Doctype
b [Miscellaneous]
c) = forall a. NFData a => a -> ()
rnf [Miscellaneous]
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Doctype
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Miscellaneous]
c seq :: forall a b. a -> b -> b
`seq` ()
data Instruction = Instruction
{ Instruction -> Text
instructionTarget :: Text
, Instruction -> Text
instructionData :: Text
}
deriving (Instruction -> Instruction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instruction -> Instruction -> Bool
$c/= :: Instruction -> Instruction -> Bool
== :: Instruction -> Instruction -> Bool
$c== :: Instruction -> Instruction -> Bool
Eq, Eq Instruction
Instruction -> Instruction -> Bool
Instruction -> Instruction -> Ordering
Instruction -> Instruction -> Instruction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instruction -> Instruction -> Instruction
$cmin :: Instruction -> Instruction -> Instruction
max :: Instruction -> Instruction -> Instruction
$cmax :: Instruction -> Instruction -> Instruction
>= :: Instruction -> Instruction -> Bool
$c>= :: Instruction -> Instruction -> Bool
> :: Instruction -> Instruction -> Bool
$c> :: Instruction -> Instruction -> Bool
<= :: Instruction -> Instruction -> Bool
$c<= :: Instruction -> Instruction -> Bool
< :: Instruction -> Instruction -> Bool
$c< :: Instruction -> Instruction -> Bool
compare :: Instruction -> Instruction -> Ordering
$ccompare :: Instruction -> Instruction -> Ordering
Ord, Int -> Instruction -> ShowS
[Instruction] -> ShowS
Instruction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instruction] -> ShowS
$cshowList :: [Instruction] -> ShowS
show :: Instruction -> String
$cshow :: Instruction -> String
showsPrec :: Int -> Instruction -> ShowS
$cshowsPrec :: Int -> Instruction -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Instruction
Instruction -> Constr
Instruction -> DataType
(forall b. Data b => b -> b) -> Instruction -> Instruction
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Instruction -> u
forall u. (forall d. Data d => d -> u) -> Instruction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Instruction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Instruction -> c Instruction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Instruction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Instruction)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Instruction -> m Instruction
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Instruction -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Instruction -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Instruction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Instruction -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Instruction -> r
gmapT :: (forall b. Data b => b -> b) -> Instruction -> Instruction
$cgmapT :: (forall b. Data b => b -> b) -> Instruction -> Instruction
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Instruction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Instruction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Instruction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Instruction)
dataTypeOf :: Instruction -> DataType
$cdataTypeOf :: Instruction -> DataType
toConstr :: Instruction -> Constr
$ctoConstr :: Instruction -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Instruction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Instruction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Instruction -> c Instruction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Instruction -> c Instruction
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Instruction x -> Instruction
forall x. Instruction -> Rep Instruction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instruction x -> Instruction
$cfrom :: forall x. Instruction -> Rep Instruction x
Generic
#endif
#endif
)
instance NFData Instruction where
rnf :: Instruction -> ()
rnf (Instruction Text
a Text
b) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Text
b seq :: forall a b. a -> b -> b
`seq` ()
data Miscellaneous
= MiscInstruction Instruction
| Text
deriving (Miscellaneous -> Miscellaneous -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Miscellaneous -> Miscellaneous -> Bool
$c/= :: Miscellaneous -> Miscellaneous -> Bool
== :: Miscellaneous -> Miscellaneous -> Bool
$c== :: Miscellaneous -> Miscellaneous -> Bool
Eq, Eq Miscellaneous
Miscellaneous -> Miscellaneous -> Bool
Miscellaneous -> Miscellaneous -> Ordering
Miscellaneous -> Miscellaneous -> Miscellaneous
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Miscellaneous -> Miscellaneous -> Miscellaneous
$cmin :: Miscellaneous -> Miscellaneous -> Miscellaneous
max :: Miscellaneous -> Miscellaneous -> Miscellaneous
$cmax :: Miscellaneous -> Miscellaneous -> Miscellaneous
>= :: Miscellaneous -> Miscellaneous -> Bool
$c>= :: Miscellaneous -> Miscellaneous -> Bool
> :: Miscellaneous -> Miscellaneous -> Bool
$c> :: Miscellaneous -> Miscellaneous -> Bool
<= :: Miscellaneous -> Miscellaneous -> Bool
$c<= :: Miscellaneous -> Miscellaneous -> Bool
< :: Miscellaneous -> Miscellaneous -> Bool
$c< :: Miscellaneous -> Miscellaneous -> Bool
compare :: Miscellaneous -> Miscellaneous -> Ordering
$ccompare :: Miscellaneous -> Miscellaneous -> Ordering
Ord, Int -> Miscellaneous -> ShowS
[Miscellaneous] -> ShowS
Miscellaneous -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Miscellaneous] -> ShowS
$cshowList :: [Miscellaneous] -> ShowS
show :: Miscellaneous -> String
$cshow :: Miscellaneous -> String
showsPrec :: Int -> Miscellaneous -> ShowS
$cshowsPrec :: Int -> Miscellaneous -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Miscellaneous
Miscellaneous -> Constr
Miscellaneous -> DataType
(forall b. Data b => b -> b) -> Miscellaneous -> Miscellaneous
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Miscellaneous -> u
forall u. (forall d. Data d => d -> u) -> Miscellaneous -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Miscellaneous
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Miscellaneous -> c Miscellaneous
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Miscellaneous)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Miscellaneous)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Miscellaneous -> m Miscellaneous
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Miscellaneous -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Miscellaneous -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Miscellaneous -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Miscellaneous -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Miscellaneous -> r
gmapT :: (forall b. Data b => b -> b) -> Miscellaneous -> Miscellaneous
$cgmapT :: (forall b. Data b => b -> b) -> Miscellaneous -> Miscellaneous
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Miscellaneous)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Miscellaneous)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Miscellaneous)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Miscellaneous)
dataTypeOf :: Miscellaneous -> DataType
$cdataTypeOf :: Miscellaneous -> DataType
toConstr :: Miscellaneous -> Constr
$ctoConstr :: Miscellaneous -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Miscellaneous
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Miscellaneous
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Miscellaneous -> c Miscellaneous
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Miscellaneous -> c Miscellaneous
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Miscellaneous x -> Miscellaneous
forall x. Miscellaneous -> Rep Miscellaneous x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Miscellaneous x -> Miscellaneous
$cfrom :: forall x. Miscellaneous -> Rep Miscellaneous x
Generic
#endif
#endif
)
instance NFData Miscellaneous where
rnf :: Miscellaneous -> ()
rnf (MiscInstruction Instruction
a) = forall a. NFData a => a -> ()
rnf Instruction
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (MiscComment Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
data Node
= NodeElement Element
| NodeInstruction Instruction
| NodeContent Content
| Text
deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Eq Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
Ord, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Node
Node -> Constr
Node -> DataType
(forall b. Data b => b -> b) -> Node -> Node
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
forall u. (forall d. Data d => d -> u) -> Node -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapT :: (forall b. Data b => b -> b) -> Node -> Node
$cgmapT :: (forall b. Data b => b -> b) -> Node -> Node
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
dataTypeOf :: Node -> DataType
$cdataTypeOf :: Node -> DataType
toConstr :: Node -> Constr
$ctoConstr :: Node -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic
#endif
#endif
)
instance NFData Node where
rnf :: Node -> ()
rnf (NodeElement Element
a) = forall a. NFData a => a -> ()
rnf Element
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (NodeInstruction Instruction
a) = forall a. NFData a => a -> ()
rnf Instruction
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (NodeContent Content
a) = forall a. NFData a => a -> ()
rnf Content
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (NodeComment Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
instance IsString Node where
fromString :: String -> Node
fromString = Content -> Node
NodeContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
data Element = Element
{ Element -> Name
elementName :: Name
, Element -> [(Name, [Content])]
elementAttributes :: [(Name, [Content])]
, Element -> [Node]
elementNodes :: [Node]
}
deriving (Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Eq Element
Element -> Element -> Bool
Element -> Element -> Ordering
Element -> Element -> Element
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Element -> Element -> Element
$cmin :: Element -> Element -> Element
max :: Element -> Element -> Element
$cmax :: Element -> Element -> Element
>= :: Element -> Element -> Bool
$c>= :: Element -> Element -> Bool
> :: Element -> Element -> Bool
$c> :: Element -> Element -> Bool
<= :: Element -> Element -> Bool
$c<= :: Element -> Element -> Bool
< :: Element -> Element -> Bool
$c< :: Element -> Element -> Bool
compare :: Element -> Element -> Ordering
$ccompare :: Element -> Element -> Ordering
Ord, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Element
Element -> Constr
Element -> DataType
(forall b. Data b => b -> b) -> Element -> Element
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
forall u. (forall d. Data d => d -> u) -> Element -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Element -> m Element
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Element -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Element -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Element -> r
gmapT :: (forall b. Data b => b -> b) -> Element -> Element
$cgmapT :: (forall b. Data b => b -> b) -> Element -> Element
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Element)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Element)
dataTypeOf :: Element -> DataType
$cdataTypeOf :: Element -> DataType
toConstr :: Element -> Constr
$ctoConstr :: Element -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Element
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Element -> c Element
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Element x -> Element
forall x. Element -> Rep Element x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Element x -> Element
$cfrom :: forall x. Element -> Rep Element x
Generic
#endif
#endif
)
instance NFData Element where
rnf :: Element -> ()
rnf (Element Name
a [(Name, [Content])]
b [Node]
c) = forall a. NFData a => a -> ()
rnf Name
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [(Name, [Content])]
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Node]
c seq :: forall a b. a -> b -> b
`seq` ()
data Content
= ContentText Text
| ContentEntity Text
deriving (Content -> Content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq, Eq Content
Content -> Content -> Bool
Content -> Content -> Ordering
Content -> Content -> Content
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Content -> Content -> Content
$cmin :: Content -> Content -> Content
max :: Content -> Content -> Content
$cmax :: Content -> Content -> Content
>= :: Content -> Content -> Bool
$c>= :: Content -> Content -> Bool
> :: Content -> Content -> Bool
$c> :: Content -> Content -> Bool
<= :: Content -> Content -> Bool
$c<= :: Content -> Content -> Bool
< :: Content -> Content -> Bool
$c< :: Content -> Content -> Bool
compare :: Content -> Content -> Ordering
$ccompare :: Content -> Content -> Ordering
Ord, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Content
Content -> Constr
Content -> DataType
(forall b. Data b => b -> b) -> Content -> Content
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
forall u. (forall d. Data d => d -> u) -> Content -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapT :: (forall b. Data b => b -> b) -> Content -> Content
$cgmapT :: (forall b. Data b => b -> b) -> Content -> Content
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
dataTypeOf :: Content -> DataType
$cdataTypeOf :: Content -> DataType
toConstr :: Content -> Constr
$ctoConstr :: Content -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Content x -> Content
forall x. Content -> Rep Content x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Content x -> Content
$cfrom :: forall x. Content -> Rep Content x
Generic
#endif
#endif
)
instance NFData Content where
rnf :: Content -> ()
rnf (ContentText Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (ContentEntity Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
instance IsString Content where
fromString :: String -> Content
fromString = Text -> Content
ContentText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
data Name = Name
{ Name -> Text
nameLocalName :: Text
, Name -> Maybe Text
nameNamespace :: Maybe Text
, Name -> Maybe Text
namePrefix :: Maybe Text
}
deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Name
Name -> Constr
Name -> DataType
(forall b. Data b => b -> b) -> Name -> Name
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
forall u. (forall d. Data d => d -> u) -> Name -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Name -> m Name
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name -> m Name
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Name
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name -> c Name
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Name)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name -> m Name
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name -> m Name
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name -> m Name
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name -> m Name
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Name -> m Name
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Name -> m Name
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Name -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Name -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Name -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r
gmapT :: (forall b. Data b => b -> b) -> Name -> Name
$cgmapT :: (forall b. Data b => b -> b) -> Name -> Name
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Name)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Name)
dataTypeOf :: Name -> DataType
$cdataTypeOf :: Name -> DataType
toConstr :: Name -> Constr
$ctoConstr :: Name -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Name
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Name
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name -> c Name
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name -> c Name
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generic
#endif
#endif
)
instance Eq Name where
== :: Name -> Name -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\Name
x -> (Name -> Maybe Text
nameNamespace Name
x, Name -> Text
nameLocalName Name
x))
instance Ord Name where
compare :: Name -> Name -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\Name
x -> (Name -> Maybe Text
nameNamespace Name
x, Name -> Text
nameLocalName Name
x))
instance IsString Name where
fromString :: String -> Name
fromString String
"" = Text -> Maybe Text -> Maybe Text -> Name
Name Text
T.empty forall a. Maybe a
Nothing forall a. Maybe a
Nothing
fromString full :: String
full@(Char
'{':String
rest) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'}') String
rest of
(String
_, String
"") -> forall a. HasCallStack => String -> a
error (String
"Invalid Clark notation: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
full)
(String
ns, String
local) -> Text -> Maybe Text -> Maybe Text -> Name
Name (String -> Text
T.pack (forall a. Int -> [a] -> [a]
drop Int
1 String
local)) (forall a. a -> Maybe a
Just (String -> Text
T.pack String
ns)) forall a. Maybe a
Nothing
fromString String
local = Text -> Maybe Text -> Maybe Text -> Name
Name (String -> Text
T.pack String
local) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
instance NFData Name where
rnf :: Name -> ()
rnf (Name Text
a Maybe Text
b Maybe Text
c) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Text
b seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Text
c seq :: forall a b. a -> b -> b
`seq` ()
data Doctype = Doctype
{ Doctype -> Text
doctypeName :: Text
, Doctype -> Maybe ExternalID
doctypeID :: Maybe ExternalID
}
deriving (Doctype -> Doctype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Doctype -> Doctype -> Bool
$c/= :: Doctype -> Doctype -> Bool
== :: Doctype -> Doctype -> Bool
$c== :: Doctype -> Doctype -> Bool
Eq, Eq Doctype
Doctype -> Doctype -> Bool
Doctype -> Doctype -> Ordering
Doctype -> Doctype -> Doctype
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Doctype -> Doctype -> Doctype
$cmin :: Doctype -> Doctype -> Doctype
max :: Doctype -> Doctype -> Doctype
$cmax :: Doctype -> Doctype -> Doctype
>= :: Doctype -> Doctype -> Bool
$c>= :: Doctype -> Doctype -> Bool
> :: Doctype -> Doctype -> Bool
$c> :: Doctype -> Doctype -> Bool
<= :: Doctype -> Doctype -> Bool
$c<= :: Doctype -> Doctype -> Bool
< :: Doctype -> Doctype -> Bool
$c< :: Doctype -> Doctype -> Bool
compare :: Doctype -> Doctype -> Ordering
$ccompare :: Doctype -> Doctype -> Ordering
Ord, Int -> Doctype -> ShowS
[Doctype] -> ShowS
Doctype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Doctype] -> ShowS
$cshowList :: [Doctype] -> ShowS
show :: Doctype -> String
$cshow :: Doctype -> String
showsPrec :: Int -> Doctype -> ShowS
$cshowsPrec :: Int -> Doctype -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Doctype
Doctype -> Constr
Doctype -> DataType
(forall b. Data b => b -> b) -> Doctype -> Doctype
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Doctype -> u
forall u. (forall d. Data d => d -> u) -> Doctype -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doctype
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doctype -> c Doctype
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doctype)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doctype)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doctype -> m Doctype
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Doctype -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Doctype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Doctype -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Doctype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Doctype -> r
gmapT :: (forall b. Data b => b -> b) -> Doctype -> Doctype
$cgmapT :: (forall b. Data b => b -> b) -> Doctype -> Doctype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doctype)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Doctype)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doctype)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Doctype)
dataTypeOf :: Doctype -> DataType
$cdataTypeOf :: Doctype -> DataType
toConstr :: Doctype -> Constr
$ctoConstr :: Doctype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doctype
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Doctype
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doctype -> c Doctype
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doctype -> c Doctype
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Doctype x -> Doctype
forall x. Doctype -> Rep Doctype x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Doctype x -> Doctype
$cfrom :: forall x. Doctype -> Rep Doctype x
Generic
#endif
#endif
)
instance NFData Doctype where
rnf :: Doctype -> ()
rnf (Doctype Text
a Maybe ExternalID
b) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe ExternalID
b seq :: forall a b. a -> b -> b
`seq` ()
data ExternalID
= SystemID Text
| PublicID Text Text
deriving (ExternalID -> ExternalID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalID -> ExternalID -> Bool
$c/= :: ExternalID -> ExternalID -> Bool
== :: ExternalID -> ExternalID -> Bool
$c== :: ExternalID -> ExternalID -> Bool
Eq, Eq ExternalID
ExternalID -> ExternalID -> Bool
ExternalID -> ExternalID -> Ordering
ExternalID -> ExternalID -> ExternalID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExternalID -> ExternalID -> ExternalID
$cmin :: ExternalID -> ExternalID -> ExternalID
max :: ExternalID -> ExternalID -> ExternalID
$cmax :: ExternalID -> ExternalID -> ExternalID
>= :: ExternalID -> ExternalID -> Bool
$c>= :: ExternalID -> ExternalID -> Bool
> :: ExternalID -> ExternalID -> Bool
$c> :: ExternalID -> ExternalID -> Bool
<= :: ExternalID -> ExternalID -> Bool
$c<= :: ExternalID -> ExternalID -> Bool
< :: ExternalID -> ExternalID -> Bool
$c< :: ExternalID -> ExternalID -> Bool
compare :: ExternalID -> ExternalID -> Ordering
$ccompare :: ExternalID -> ExternalID -> Ordering
Ord, Int -> ExternalID -> ShowS
[ExternalID] -> ShowS
ExternalID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalID] -> ShowS
$cshowList :: [ExternalID] -> ShowS
show :: ExternalID -> String
$cshow :: ExternalID -> String
showsPrec :: Int -> ExternalID -> ShowS
$cshowsPrec :: Int -> ExternalID -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable ExternalID
ExternalID -> Constr
ExternalID -> DataType
(forall b. Data b => b -> b) -> ExternalID -> ExternalID
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExternalID -> u
forall u. (forall d. Data d => d -> u) -> ExternalID -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExternalID
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExternalID -> c ExternalID
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExternalID)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExternalID)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExternalID -> m ExternalID
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExternalID -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExternalID -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExternalID -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExternalID -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExternalID -> r
gmapT :: (forall b. Data b => b -> b) -> ExternalID -> ExternalID
$cgmapT :: (forall b. Data b => b -> b) -> ExternalID -> ExternalID
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExternalID)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExternalID)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExternalID)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExternalID)
dataTypeOf :: ExternalID -> DataType
$cdataTypeOf :: ExternalID -> DataType
toConstr :: ExternalID -> Constr
$ctoConstr :: ExternalID -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExternalID
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExternalID
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExternalID -> c ExternalID
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExternalID -> c ExternalID
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep ExternalID x -> ExternalID
forall x. ExternalID -> Rep ExternalID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExternalID x -> ExternalID
$cfrom :: forall x. ExternalID -> Rep ExternalID x
Generic
#endif
#endif
)
instance NFData ExternalID where
rnf :: ExternalID -> ()
rnf (SystemID Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (PublicID Text
a Text
b) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Text
b seq :: forall a b. a -> b -> b
`seq` ()
data Event
= EventBeginDocument
| EventEndDocument
| EventBeginDoctype Text (Maybe ExternalID)
| EventEndDoctype
| EventInstruction Instruction
| EventBeginElement Name [(Name, [Content])]
| EventEndElement Name
| EventContent Content
| Text
| EventCDATA Text
deriving (Event -> Event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Eq Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show
#if __GLASGOW_HASKELL__
, Typeable Event
Event -> Constr
Event -> DataType
(forall b. Data b => b -> b) -> Event -> Event
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
forall u. (forall d. Data d => d -> u) -> Event -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Event -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Event -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapT :: (forall b. Data b => b -> b) -> Event -> Event
$cgmapT :: (forall b. Data b => b -> b) -> Event -> Event
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
dataTypeOf :: Event -> DataType
$cdataTypeOf :: Event -> DataType
toConstr :: Event -> Constr
$ctoConstr :: Event -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
Data, Typeable
#if MIN_VERSION_base(4,4,0)
, forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic
#endif
#endif
)
instance NFData Event where
rnf :: Event -> ()
rnf (EventBeginDoctype Text
a Maybe ExternalID
b) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe ExternalID
b seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventInstruction Instruction
a) = forall a. NFData a => a -> ()
rnf Instruction
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventBeginElement Name
a [(Name, [Content])]
b) = forall a. NFData a => a -> ()
rnf Name
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [(Name, [Content])]
b seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventEndElement Name
a) = forall a. NFData a => a -> ()
rnf Name
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventContent Content
a) = forall a. NFData a => a -> ()
rnf Content
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventComment Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
rnf (EventCDATA Text
a) = forall a. NFData a => a -> ()
rnf Text
a seq :: forall a b. a -> b -> b
`seq` ()
rnf Event
_ = ()
isElement :: Node -> [Element]
isElement :: Node -> [Element]
isElement (NodeElement Element
e) = [Element
e]
isElement Node
_ = []
isInstruction :: Node -> [Instruction]
isInstruction :: Node -> [Instruction]
isInstruction (NodeInstruction Instruction
i) = [Instruction
i]
isInstruction Node
_ = []
isContent :: Node -> [Content]
isContent :: Node -> [Content]
isContent (NodeContent Content
c) = [Content
c]
isContent Node
_ = []
isComment :: Node -> [Text]
(NodeComment Text
t) = [Text
t]
isComment Node
_ = []
isNamed :: Name -> Element -> [Element]
isNamed :: Name -> Element -> [Element]
isNamed Name
n Element
e = [Element
e | Element -> Name
elementName Element
e forall a. Eq a => a -> a -> Bool
== Name
n]
elementChildren :: Element -> [Element]
elementChildren :: Element -> [Element]
elementChildren = Element -> [Node]
elementNodes forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [Element]
isElement
elementContent :: Element -> [Content]
elementContent :: Element -> [Content]
elementContent = Element -> [Node]
elementNodes forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [Content]
isContent
elementText :: Element -> [Text]
elementText :: Element -> [Text]
elementText = Element -> [Content]
elementContent forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Content -> [Text]
contentText
nodeChildren :: Node -> [Node]
nodeChildren :: Node -> [Node]
nodeChildren = Node -> [Element]
isElement forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Element -> [Node]
elementNodes
nodeContent :: Node -> [Content]
nodeContent :: Node -> [Content]
nodeContent = Node -> [Node]
nodeChildren forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Node -> [Content]
isContent
nodeText :: Node -> [Text]
nodeText :: Node -> [Text]
nodeText = Node -> [Content]
nodeContent forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Content -> [Text]
contentText
hasAttribute :: Name -> Element -> [Element]
hasAttribute :: Name -> Element -> [Element]
hasAttribute Name
name Element
e = [Element
e | forall a. Maybe a -> Bool
isJust (Name -> Element -> Maybe [Content]
attributeContent Name
name Element
e)]
hasAttributeText :: Name -> (Text -> Bool) -> Element -> [Element]
hasAttributeText :: Name -> (Text -> Bool) -> Element -> [Element]
hasAttributeText Name
name Text -> Bool
p Element
e = [Element
e | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
p (Name -> Element -> Maybe Text
attributeText Name
name Element
e)]
attributeContent :: Name -> Element -> Maybe [Content]
attributeContent :: Name -> Element -> Maybe [Content]
attributeContent Name
name Element
e = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
name (Element -> [(Name, [Content])]
elementAttributes Element
e)
attributeText :: Name -> Element -> Maybe Text
attributeText :: Name -> Element -> Maybe Text
attributeText Name
name Element
e = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Text
contentFlat (Name -> Element -> Maybe [Content]
attributeContent Name
name Element
e)
contentText :: Content -> [Text]
contentText :: Content -> [Text]
contentText (ContentText Text
t) = [Text
t]
contentText (ContentEntity Text
entity) = [String -> Text
T.pack String
"&", Text
entity, String -> Text
T.pack String
";"]
contentFlat :: [Content] -> Text
contentFlat :: [Content] -> Text
contentFlat [Content]
cs = [Text] -> Text
T.concat ([Content]
cs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Content -> [Text]
contentText)