diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,22 @@ +Copyright (c) 2010 John Millikin + +Permission is hereby granted, free of charge, to any person +obtaining a copy of this software and associated documentation +files (the "Software"), to deal in the Software without +restriction, including without limitation the rights to use, +copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following +conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/Data/XML/Types.hs b/Data/XML/Types.hs deleted file mode 100644 --- a/Data/XML/Types.hs +++ /dev/null @@ -1,229 +0,0 @@ --- Copyright (c) 2010 John Millikin --- --- Permission is hereby granted, free of charge, to any person --- obtaining a copy of this software and associated documentation --- files (the "Software"), to deal in the Software without --- restriction, including without limitation the rights to use, --- copy, modify, merge, publish, distribute, sublicense, and/or sell --- copies of the Software, and to permit persons to whom the --- Software is furnished to do so, subject to the following --- conditions: --- --- The above copyright notice and this permission notice shall be --- included in all copies or substantial portions of the Software. --- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, --- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES --- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND --- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT --- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, --- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING --- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --- OTHER DEALINGS IN THE SOFTWARE. - -module Data.XML.Types - ( -- * Types - -- ** Document prologue - Document (..) - , Prologue (..) - , Instruction (..) - , Miscellaneous (..) - - -- ** Document body - , Node (..) - , Element (..) - , Attribute (..) - , Content (..) - , Name (..) - , Named (..) - - -- ** Doctypes - , Doctype (..) - , ExternalID (..) - , InternalSubset - - -- ** Incremental processing - , Event (..) - - -- * Predicates - , isElement - , isInstruction - , isContent - , isComment - , isNamed - - -- * Filters - , nodeChildren - , elementChildren - , elementContent - , hasAttribute - , position - ) where -import Control.Monad ((>=>)) -import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy as T -import Data.String (IsString, fromString) -import Data.Function (on) - -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, Ord) - -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) - --- | Ignores prefixes -instance Eq Name where - (==) = (==) `on` (\x -> (nameNamespace x, nameLocalName x)) - --- | Ignores prefixes --- --- Since 0.1.3 -instance Ord Name where - compare = compare `on` (\x -> (nameNamespace x, nameLocalName x)) - --- | Supports Clark notation; see and --- --- --- Since 0.1.2 -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) - --- | Since 0.1.3 -instance Ord Doctype where - compare = compare `on` (\x -> (doctypeName x, doctypeExternalID x)) - -data ExternalID - = SystemID Text - | PublicID Text Text - deriving (Show, Eq, Ord) - -data InternalSubset = InternalSubset - -- TODO - deriving (Show, Eq) - --- | Some XML processing tools are incremental, and work in terms of events --- rather than node trees. Defining the event type here, even though it won't --- be useful to most users, allows these packages to interoperate more easily. --- --- Since: 0.1.1 -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 - --- | Since 0.1.4 -elementContent :: Element -> [Content] -elementContent = elementNodes >=> isContent - -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)] diff --git a/lib/Data/XML/Types.hs b/lib/Data/XML/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Data/XML/Types.hs @@ -0,0 +1,395 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ +{-# LANGUAGE DeriveDataTypeable #-} +#if MIN_VERSION_base(4,4,0) +{-# LANGUAGE DeriveGeneric #-} +#endif +#endif + +-- | +-- Module: Data.XML.Types +-- Copyright: 2010-2011 John Millikin +-- License: MIT +-- +-- Basic types for representing XML. +-- +-- The idea is to have a full set of appropriate types, which various XML +-- libraries can share. Instead of having equivalent-but-incompatible types +-- for every binding, parser, or client, they all share the same types can +-- can thus interoperate easily. +-- +-- This library contains complete types for most parts of an XML document, +-- including the prologue, node tree, and doctype. Some basic combinators +-- are included for common tasks, including traversing the node tree and +-- filtering children. +-- +module Data.XML.Types + ( -- * Types + + -- ** Document prologue + Document (..) + , Prologue (..) + , Instruction (..) + , Miscellaneous (..) + + -- ** Document body + , Node (..) + , Element (..) + , Content (..) + , Name (..) + + -- ** Doctypes + , Doctype (..) + , ExternalID (..) + + -- ** Incremental processing + , Event (..) + + -- * Combinators + + -- ** Filters + , isElement + , isInstruction + , isContent + , isComment + , isNamed + + -- ** Element traversal + , elementChildren + , elementContent + , elementText + + -- ** Node traversal + , nodeChildren + , nodeContent + , nodeText + + -- ** Attributes + , 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 + { documentPrologue :: Prologue + , documentRoot :: Element + , documentEpilogue :: [Miscellaneous] + } + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Document where + rnf (Document a b c) = rnf a `seq` rnf b `seq` rnf c `seq` () + +data Prologue = Prologue + { prologueBefore :: [Miscellaneous] + , prologueDoctype :: Maybe Doctype + , prologueAfter :: [Miscellaneous] + } + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Prologue where + rnf (Prologue a b c) = rnf a `seq` rnf b `seq` rnf c `seq` () + +data Instruction = Instruction + { instructionTarget :: Text + , instructionData :: Text + } + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Instruction where + rnf (Instruction a b) = rnf a `seq` rnf b `seq` () + +data Miscellaneous + = MiscInstruction Instruction + | MiscComment Text + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Miscellaneous where + rnf (MiscInstruction a) = rnf a `seq` () + rnf (MiscComment a) = rnf a `seq` () + +data Node + = NodeElement Element + | NodeInstruction Instruction + | NodeContent Content + | NodeComment Text + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Node where + rnf (NodeElement a) = rnf a `seq` () + rnf (NodeInstruction a) = rnf a `seq` () + rnf (NodeContent a) = rnf a `seq` () + rnf (NodeComment a) = rnf a `seq` () + +instance IsString Node where + fromString = NodeContent . fromString + +data Element = Element + { elementName :: Name + , elementAttributes :: [(Name, [Content])] + , elementNodes :: [Node] + } + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Element where + rnf (Element a b c) = rnf a `seq` rnf b `seq` rnf c `seq` () + +data Content + = ContentText Text + | ContentEntity Text -- ^ For pass-through parsing + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Content where + rnf (ContentText a) = rnf a `seq` () + rnf (ContentEntity a) = rnf a `seq` () + +instance IsString Content where + fromString = ContentText . fromString + +-- | A fully qualified name. +-- +-- Prefixes are not semantically important; they are included only to +-- simplify pass-through parsing. When comparing names with 'Eq' or 'Ord' +-- methods, prefixes are ignored. +-- +-- The @IsString@ instance supports Clark notation; see +-- and +-- . Use +-- the @OverloadedStrings@ language extension for very simple @Name@ +-- construction: +-- +-- > myname :: Name +-- > myname = "{http://example.com/ns/my-namespace}my-name" +-- +data Name = Name + { nameLocalName :: Text + , nameNamespace :: Maybe Text + , namePrefix :: Maybe Text + } + deriving (Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance Eq Name where + (==) = (==) `on` (\x -> (nameNamespace x, nameLocalName x)) + +instance Ord Name where + compare = compare `on` (\x -> (nameNamespace x, nameLocalName x)) + +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 + +instance NFData Name where + rnf (Name a b c) = rnf a `seq` rnf b `seq` rnf c `seq` () + +-- | Note: due to the incredible complexity of DTDs, this type only supports +-- external subsets. I've tried adding internal subset types, but they +-- quickly gain more code than the rest of this module put together. +-- +-- It is possible that some future version of this library might support +-- internal subsets, but I am no longer actively working on adding them. +data Doctype = Doctype + { doctypeName :: Text + , doctypeID :: Maybe ExternalID + } + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Doctype where + rnf (Doctype a b) = rnf a `seq` rnf b `seq` () + +data ExternalID + = SystemID Text + | PublicID Text Text + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData ExternalID where + rnf (SystemID a) = rnf a `seq` () + rnf (PublicID a b) = rnf a `seq` rnf b `seq` () + +-- | Some XML processing tools are incremental, and work in terms of events +-- rather than node trees. The 'Event' type allows a document to be fully +-- specified as a sequence of events. +-- +-- Event-based XML libraries include: +-- +-- * +-- +-- * +-- +-- * +-- +data Event + = EventBeginDocument + | EventEndDocument + | EventBeginDoctype Text (Maybe ExternalID) + | EventEndDoctype + | EventInstruction Instruction + | EventBeginElement Name [(Name, [Content])] + | EventEndElement Name + | EventContent Content + | EventComment Text + | EventCDATA Text + deriving (Eq, Ord, Show +#if __GLASGOW_HASKELL__ + , Data, Typeable +#if MIN_VERSION_base(4,4,0) + , Generic +#endif +#endif + ) + +instance NFData Event where + rnf (EventBeginDoctype a b) = rnf a `seq` rnf b `seq` () + rnf (EventInstruction a) = rnf a `seq` () + rnf (EventBeginElement a b) = rnf a `seq` rnf b `seq` () + rnf (EventEndElement a) = rnf a `seq` () + rnf (EventContent a) = rnf a `seq` () + rnf (EventComment a) = rnf a `seq` () + rnf (EventCDATA a) = rnf a `seq` () + rnf _ = () + +isElement :: Node -> [Element] +isElement (NodeElement e) = [e] +isElement _ = [] + +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 :: Name -> Element -> [Element] +isNamed n e = [e | elementName e == n] + +elementChildren :: Element -> [Element] +elementChildren = elementNodes >=> isElement + +elementContent :: Element -> [Content] +elementContent = elementNodes >=> isContent + +elementText :: Element -> [Text] +elementText = elementContent >=> contentText + +nodeChildren :: Node -> [Node] +nodeChildren = isElement >=> elementNodes + +nodeContent :: Node -> [Content] +nodeContent = nodeChildren >=> isContent + +nodeText :: Node -> [Text] +nodeText = nodeContent >=> contentText + +hasAttribute :: Name -> Element -> [Element] +hasAttribute name e = [e | isJust (attributeContent name e)] + +hasAttributeText :: Name -> (Text -> Bool) -> Element -> [Element] +hasAttributeText name p e = [e | maybe False p (attributeText name e)] + +attributeContent :: Name -> Element -> Maybe [Content] +attributeContent name e = lookup name (elementAttributes e) + +attributeText :: Name -> Element -> Maybe Text +attributeText name e = fmap contentFlat (attributeContent name e) + +contentText :: Content -> [Text] +contentText (ContentText t) = [t] +contentText (ContentEntity entity) = [T.pack "&", entity, T.pack ";"] + +contentFlat :: [Content] -> Text +contentFlat cs = T.concat (cs >>= contentText) diff --git a/license.txt b/license.txt deleted file mode 100644 --- a/license.txt +++ /dev/null @@ -1,22 +0,0 @@ -Copyright (c) 2010 John Millikin - -Permission is hereby granted, free of charge, to any person -obtaining a copy of this software and associated documentation -files (the "Software"), to deal in the Software without -restriction, including without limitation the rights to use, -copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the -Software is furnished to do so, subject to the following -conditions: - -The above copyright notice and this permission notice shall be -included in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES -OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT -HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, -WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. diff --git a/xml-types.cabal b/xml-types.cabal --- a/xml-types.cabal +++ b/xml-types.cabal @@ -1,25 +1,46 @@ name: xml-types -version: 0.1.4 +version: 0.3.8 synopsis: Basic types for representing XML license: MIT -license-file: license.txt +license-file: COPYING author: John Millikin -maintainer: jmillikin@gmail.com +maintainer: Stephen Paul Weber build-type: Simple -cabal-version: >=1.6 +cabal-version: >= 1.10 category: Text, XML stability: experimental -bug-reports: mailto:jmillikin@gmail.com +homepage: https://git.singpolyma.net/xml-types-haskell +bug-reports: mailto:dev@singpolyma.net +description: + Basic types for representing XML. + . + The idea is to have a full set of appropriate types, which various XML + libraries can share. Instead of having equivalent-but-incompatible types + for every binding, parser, or client, they all share the same types can + can thus interoperate easily. + . + This library contains complete types for most parts of an XML document, + including the prologue, node tree, and doctype. Some basic combinators + are included for common tasks, including traversing the node tree and + filtering children. source-repository head - type: bazaar - location: http://john-millikin.com/software/xml-types/ + type: git + location: https://git.singpolyma.net/xml-types-haskell +source-repository this + type: git + location: https://git.singpolyma.net/xml-types-haskell + tag: 0.3.8 + library + default-language: Haskell2010 ghc-options: -Wall + hs-source-dirs: lib build-depends: - base >=3 && < 5 + base >= 3.0 && < 5.0 + , deepseq >= 1.1.0.0 , text exposed-modules: