module Data.XML.Types
(
Document (..)
, Prologue (..)
, Instruction (..)
, Miscellaneous (..)
, Node (..)
, Element (..)
, Attribute (..)
, Content (..)
, Name (..)
, Named (..)
, Doctype (..)
, ExternalID (..)
, InternalSubset
, Event (..)
, isElement
, isInstruction
, isContent
, isComment
, isNamed
, nodeChildren
, elementChildren
, hasAttribute
, position
) where
import Control.Monad ((>=>))
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import Data.String (IsString, fromString)
data Document = Document
{ documentPrologue :: Prologue
, documentRoot :: Element
, documentEpilogue :: [Miscellaneous]
}
deriving (Show, Eq)
data Prologue = Prologue
{ prologueBefore :: [Miscellaneous]
, prologueDoctype :: Maybe Doctype
, prologueAfter :: [Miscellaneous]
}
deriving (Show, Eq)
data Instruction = Instruction
{ instructionTarget :: Text
, instructionData :: Text
}
deriving (Show, Eq)
data Miscellaneous
= MiscInstruction Instruction
| MiscComment Text
deriving (Show, Eq)
data Node
= NodeElement Element
| NodeInstruction Instruction
| NodeContent Content
| NodeComment Text
deriving (Show, Eq)
data Element = Element
{ elementName :: Name
, elementAttributes :: [Attribute]
, elementNodes :: [Node]
}
deriving (Show, Eq)
data Attribute = Attribute
{ attributeName :: Name
, attributeContent :: [Content]
}
deriving (Show, Eq)
data Content
= ContentText Text
| ContentEntity Text
deriving (Show, Eq)
data Name = Name
{ nameLocalName :: Text
, nameNamespace :: Maybe Text
, namePrefix :: Maybe Text
}
deriving (Show)
instance Eq Name where
x == y = and
[ nameLocalName x == nameLocalName y
, nameNamespace x == nameNamespace y
]
instance IsString Name where
fromString "" = Name T.empty Nothing Nothing
fromString full@('{':rest) = case break (== '}') rest of
(_, "") -> error ("Invalid Clark notation: " ++ show full)
(ns, local) -> Name (T.pack (drop 1 local)) (Just (T.pack ns)) Nothing
fromString local = Name (T.pack local) Nothing Nothing
class Named a where
getName :: a -> Name
instance Named Element where
getName = elementName
instance Named Attribute where
getName = attributeName
data Doctype = Doctype
{ doctypeName :: Text
, doctypeExternalID :: Maybe ExternalID
, doctypeInternalSubsets :: [InternalSubset]
}
deriving (Show, Eq)
data ExternalID
= SystemID Text
| PublicID Text Text
deriving (Show, Eq)
data InternalSubset = InternalSubset
deriving (Show, Eq)
data Event
= EventBeginDocument
| EventEndDocument
| EventInstruction Instruction
| EventDoctype Doctype
| EventBeginElement Name [Attribute]
| EventEndElement Name
| EventContent Content
| EventComment Text
deriving (Show, Eq)
isElement :: Node -> [Element]
isElement (NodeElement e) = [e]
isElement _ = []
isInstruction :: Node -> [Instruction]
isInstruction (NodeInstruction i) = [i]
isInstruction _ = []
isContent :: Node -> [Content]
isContent (NodeContent c) = [c]
isContent _ = []
isComment :: Node -> [Text]
isComment (NodeComment t) = [t]
isComment _ = []
isNamed :: Named a => Name -> a -> [a]
isNamed n x = [x | getName x == n]
elementChildren :: Element -> [Element]
elementChildren = elementNodes >=> isElement
nodeChildren :: Node -> [Node]
nodeChildren = isElement >=> elementNodes
position :: Integer -> (a -> [b]) -> a -> [b]
position n f e = safeHead n (f e)
safeHead :: Integer -> [a] -> [a]
safeHead _ [] = []
safeHead 0 (x:_) = [x]
safeHead n (_:xs) = safeHead (n 1) xs
hasAttribute :: (Attribute -> [Attribute]) -> Element -> [Element]
hasAttribute f e = [e | not $ null (elementAttributes e >>= f)]