{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- Copyright (c) 2019 Herbert Valerio Riedel This file is free software: you may copy, redistribute and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program (see `LICENSE.GPLv3`). If not, see . This file incorporates work covered by the following copyright and permission notice: (c) 2007 Galois Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -- | -- Module : Text.XML.Types -- Copyright : (c) Galois, Inc. 2007 -- (c) Herbert Valerio Riedel 2019 -- SPDX-License-Identifier: BSD-3-Clause AND GPL-3.0-or-later -- -- Basic XML types. -- module Text.XML.Types where import Common import qualified Data.Text.Short as TS import Utils type Root = Root' Content -- | Represents the implicit root node of an XML document -- -- @since 0.2.0 data Root' cnode = Root { rootXmlDeclaration :: Maybe XmlDeclaration -- ^ (optional) XML declaration , rootPreElem :: MiscNodes -- ^ Miscellaneous nodes before root element & DOCTYPE declaration , rootDoctype :: Maybe (Text,MiscNodes) -- ^ optional DOCTYPE declaration and more miscellaneous nodes between DOCTYPE and root element , rootElement :: Element' cnode -- ^ The single root document element , rootPostElem :: MiscNodes -- ^ Miscellaneous nodes after root element } deriving (Show, Typeable, Data, Generic, Functor, Foldable, Traversable) instance NFData cnode => NFData (Root' cnode) -- | Sequence of \"miscellaneous\" nodes -- -- @since 0.2.0 type MiscNodes = [Either Comment PI] -- | Denotes the @@ declaration -- -- @since 0.2.0 data XmlDeclaration = XmlDeclaration (Maybe ShortText) (Maybe Bool) deriving (Show, Typeable, Data, Generic) instance NFData XmlDeclaration -- | Processing instruction -- -- @since 0.2.0 data PI = PI { piTarget :: !ShortText -- ^ Invariant: MUST not be @[Xx][Mm][Ll]@ , piData :: !Text -- ^ Invariant: MUST not contain @?>@ } deriving (Show, Typeable, Data, Generic) instance NFData PI -- | Represents a XML comment -- -- Invariant: SHOULD not contain @--@ (occurences of @--@ will be automatically substituted by @-~@ on serialization) -- -- @since 0.2.0 newtype Comment = Comment Text deriving (Show, Typeable, Data, Generic, NFData) -- | XML content -- -- @since 0.2.0 data Content = Elem Element | Text CData | CRef !ShortText | Proc PI | Comm Comment deriving (Show, Typeable, Data, Generic) instance NFData Content type Element = Element' Content -- | XML elements data Element' cnode = Element { elName :: !QName , elAttribs :: [Attr] , elContent :: [cnode] } deriving (Show, Typeable, Data, Generic, Functor, Foldable, Traversable) instance NFData cnode => NFData (Element' cnode) -- | XML attributes data Attr = Attr { attrKey :: !QName , attrVal :: !Text } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData Attr -- | XML CData data CData = CData { cdVerbatim :: !CDataKind , cdData :: !Text } deriving (Show, Typeable, Data, Generic) instance NFData CData data CDataKind = CDataText -- ^ Ordinary character data; pretty printer escapes &, < etc. | CDataVerbatim -- ^ Unescaped character data; pretty printer embeds it in -- -- NB: Among other properties this means that an 'NCName' shall never be the empty string. -- -- @since 0.2.0 type NCName = ShortText -- | XML (expanded) qualified names data QName = QName { qLName :: !LName , qURI :: Maybe URI , qPrefix :: Maybe NCName -- ^ Invariant: MUST be a proper } deriving (Show, Typeable, Data, Generic) instance NFData QName instance Eq QName where q1 == q2 = compare q1 q2 == EQ instance Ord QName where compare q1 q2 = case compare (qLName q1) (qLName q2) of EQ -> case (qURI q1, qURI q2) of (Nothing,Nothing) -> compare (qPrefix q1) (qPrefix q2) (u1,u2) -> compare u1 u2 x -> x -- | XML local names -- -- Invariant: MUST be a proper newtype LName = LName { unLName :: NCName } deriving (Ord, Eq, Typeable, Data, IsString, NFData, Generic) -- due to the IsString instance we can just drop the constructor name instance Show LName where showsPrec p (LName s) = showsPrec p s -- | URIs resembling @anyURI@ -- -- Invariant: MUST not be @""@ newtype URI = URI { unURI :: ShortText } deriving (Ord, Eq, Typeable, Data, IsString, NFData, Generic) -- due to the IsString instance we can just drop the constructor name instance Show URI where showsPrec p (URI s) = showsPrec p s -- | Position expressed in number of code-points -- -- A negative value denotes EOF type Pos = Int -- blank elements -------------------------------------------------------------- -- | Blank names blank_name :: QName blank_name = QName { qLName = LName mempty , qURI = Nothing , qPrefix = Nothing } -- | Blank cdata blank_cdata :: CData blank_cdata = CData { cdVerbatim = CDataText , cdData = mempty } -- | Blank elements blank_element :: Element blank_element = Element { elName = blank_name , elAttribs = mempty , elContent = mempty } -- | Smart constructor for @xmlns:\ = \@ -- -- @since 0.2.0 xmlns_attr :: NCName -- ^ non-empty namespace prefix -> URI -- ^ Namespace URI -> Attr xmlns_attr pfx (URI uri) | TS.null pfx = error "Text.XML.xmlns_attr: empty namespace prefix" | otherwise = Attr (QName { qPrefix = Just (TS.pack "xmlns"), qLName = LName pfx, qURI = Just xmlnsNS }) (TS.toText uri) where xmlnsNS = URI ns_xmlns_uri -- | Smart constructor for @xmlns = [\|""]@ -- -- @since 0.2.0 xmlns_def_attr :: Maybe URI -- ^ Default namespace URI (or 'Nothing' to reset default namespace) -> Attr xmlns_def_attr muri = Attr (QName { qPrefix = Nothing, qLName = LName (TS.pack "xmlns"), qURI = Just xmlnsNS }) (case muri of { Nothing -> mempty; Just (URI uri) -> TS.toText uri}) where xmlnsNS = URI ns_xmlns_uri