xml-conduit-writer-0.1.1.2/src/ 0000755 0000000 0000000 00000000000 13163660766 014421 5 ustar 00 0000000 0000000 xml-conduit-writer-0.1.1.2/src/Text/ 0000755 0000000 0000000 00000000000 13163660766 015345 5 ustar 00 0000000 0000000 xml-conduit-writer-0.1.1.2/src/Text/XML/ 0000755 0000000 0000000 00000000000 13163676261 016002 5 ustar 00 0000000 0000000 xml-conduit-writer-0.1.1.2/test/ 0000755 0000000 0000000 00000000000 13163660766 014611 5 ustar 00 0000000 0000000 xml-conduit-writer-0.1.1.2/src/Text/XML/Writer.hs 0000644 0000000 0000000 00000013012 13163676260 017606 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- IsString for XML
-- | Overcome XML insanity, node by node.
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > let doc = document "root" $ do
-- > element "hello" $ content "world"
-- > element "hierarchy" $ do
-- > element "simple" True
-- > element "as" ("it should be" :: Text)
-- > toXML $ Just . T.pack $ "like this"
-- > comment "that's it!"
--
module Text.XML.Writer
(
-- * Documents
document, soap
, pprint
-- * Elements
, XML
-- ** Node creation
, node
, instruction
, comment
, element, elementMaybe, elementA
, content
, empty
, many
-- ** Element helpers
, render, (!:)
-- ** Converting data
, ToXML(..)
) where
import Text.XML
import Control.Monad.Writer.Strict
import Data.Default ()
import qualified Data.DList as DL
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import Data.String (IsString(..))
-- | Node container to be rendered as children nodes.
type XML = Writer (DL.DList Node) ()
-- | Create a simple Document starting with a root element.
document :: Name -- ^ Root node name
-> XML -- ^ Contents
-> Document
document name children = Document { documentPrologue = Prologue def def def
, documentRoot = Element name def (render children)
, documentEpilogue = def
}
-- | Render document using xml-conduit's pretty-printer.
pprint :: Document -> IO ()
pprint = TL.putStrLn . renderText def { rsPretty = True }
-- | Convert collected nodes to a list of child nodes.
render :: XML -> [Node]
render = DL.toList . execWriter
-- | Do nothing.
empty :: XML
empty = return ()
-- | Insert one node.
node :: Node -> XML
node = tell . DL.singleton
-- | Insert an "Element" node constructed with name and children.
element :: (ToXML a) => Name -> a -> XML
element name children = node . NodeElement $! Element name def (render $ toXML children)
-- | Insert an "Element" node converted from Maybe value or do nothing.
elementMaybe :: (ToXML a) => Name -> Maybe a -> XML
elementMaybe name = maybe empty (element name)
-- | Insert an "Element" node constructed with name, attributes and children.
elementA :: (ToXML a) => Name -> [(Name, Text)] -> a -> XML
elementA name attrs children = node . NodeElement $! Element name (M.fromList attrs) (render $ toXML children)
-- | Insert an "Instruction" node.
instruction :: Text -> Text -> XML
instruction target data_ = node . NodeInstruction $! Instruction target data_
-- | Insert a text comment node.
comment :: Text -> XML
comment = node . NodeComment
-- | Insert text content node.
content :: Text -> XML
content = node . NodeContent
-- | Mass-convert to nodes.
--
-- > let array = element "container" $ many "wrapper" [1..3]
--
-- Which gives:
--
-- >
-- > 1
-- > 2
-- > 3
-- >
--
-- Use `mapM_ toXML xs` to convert a list without wrapping
-- each item in separate element.
--
-- > let mess = element "container" $ mapM_ toXML ["chunky", "chunk"]
--
-- Content nodes tend to glue together:
--
-- > chunkychunk
many :: (ToXML a)
=> Name -- ^ Container element name.
-> [a] -- ^ Items to convert.
-> XML
many n = mapM_ (element n . toXML)
-- | Attach a prefix to a Name.
--
-- Because simply placing a colon in an element name
-- yields 'Nothing' as a prefix and children will
-- revert to en empty namespace.
(!:) :: Text -> Name -> Name
pref !: name = name { namePrefix = Just pref }
-- | Provide instances for this class to use your data
-- as "XML" nodes.
class ToXML a where
toXML :: a -> XML
-- | Do nothing.
instance ToXML () where
toXML () = empty
-- | Insert already prepared nodes.
instance ToXML XML where
toXML = id
-- | Don't use [Char] please, it will scare OverloadedStrings.
instance ToXML Text where
toXML = content
-- | XML schema uses lower case.
instance ToXML Bool where
toXML True = "true"
toXML False = "false"
instance ToXML Float where
toXML = content . T.pack . show
instance ToXML Double where
toXML = content . T.pack . show
instance ToXML Int where
toXML = content . T.pack . show
instance ToXML Integer where
toXML = content . T.pack . show
instance ToXML Char where
toXML = content . T.singleton
-- | Insert node if available. Otherwise do nothing.
instance (ToXML a) => ToXML (Maybe a) where
toXML = maybe empty toXML
instance IsString XML where
fromString = content . T.pack
-- | Generate a SOAPv1.1 document.
--
-- Empty header will be ignored.
-- Envelope uses a `soapenv` prefix.
-- Works great with 'ToXML' class.
--
-- > data BigData = BigData { webScale :: Bool }
-- > instance ToXML BigData where
-- > toXML (BigData ws) = element ("v" !: "{vendor:uri}bigData") $ toXML ws
-- > let doc = soap () (BigData True)
soap :: (ToXML h, ToXML b)
=> h
-> b
-> Document
soap header body = document (sn "Envelope") $ do
-- Some servers are allergic to dangling Headers...
when (not $ null headerContent) $ do
node . NodeElement $! Element (sn "Header") def headerContent
element (sn "Body") (toXML body)
where sn n = Name n (Just ns) (Just "soapenv")
ns = "http://schemas.xmlsoap.org/soap/envelope/"
headerContent = render (toXML header)
xml-conduit-writer-0.1.1.2/test/Main.hs 0000644 0000000 0000000 00000004052 13163660766 016032 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
import Text.XML.Writer
import qualified Data.Text as T
-- Serializing is easy!
data ExampleADT = NullaryExample
| UnaryExample String
| RecordExample { earFoo :: Int
, earBar :: Maybe Bool
, earBaz :: [Float]
}
instance ToXML ExampleADT where
toXML NullaryExample = empty
toXML (UnaryExample s) = element "unary" $ content (T.pack s)
toXML (RecordExample {earFoo = foo, earBar = bar, earBaz = baz}) =
element "record" $ do
element "foo" $ toXML foo
element "bar" $ toXML bar
element "baz" $ many "fnord" baz
main :: IO ()
main = do
pprint $ document "root" $ do
element "{ns:uri}pseudo:prefix" $ do
element "unprefixed" $ comment "empty NS"
element "pseudo:prefixed" $ comment "wrong!"
element ("sns" !: "{silly:ns:uri}spam") $ do
comment "looks good?"
elementA "unprefixed" [("with", "attrs"), ("empty", "body")] empty
element "salad" $ do
content "eggs"
content "bacon"
comment "Like a county in England"
instruction "php" "echo('goodbye, world!')"
pprint $ soap () $ do
element ("v" !: "{vendor:uri}request") $ do
element "complex" $ do
element "key" $ T.pack "value"
elementA "tag" [("key", "value")] empty
element "text" $ content "some text"
element "bool" $ toXML True
element "float" $ toXML (42 :: Float)
element "int" $ toXML (42 :: Int)
element "char" $ toXML 'Ч'
pprint $ document ("adt" !: "{org.haskell.text.xml.monad.ExampleADT}example") $ do
element "void" $ toXML NullaryExample
toXML $ UnaryExample "hi!"
toXML $ RecordExample { earFoo = 9000 + 1
, earBar = Nothing
, earBaz = [1, 2, 3]
}
xml-conduit-writer-0.1.1.2/LICENSE 0000644 0000000 0000000 00000002065 13163660766 014642 0 ustar 00 0000000 0000000 Copyright (c) 2013 Alexander Bondarenko
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.
xml-conduit-writer-0.1.1.2/Setup.hs 0000644 0000000 0000000 00000000056 13163660766 015267 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
xml-conduit-writer-0.1.1.2/xml-conduit-writer.cabal 0000644 0000000 0000000 00000002427 13163676660 020400 0 ustar 00 0000000 0000000 name: xml-conduit-writer
version: 0.1.1.2
synopsis: Warm and fuzzy creation of XML documents.
description:
“It can scarcely be denied that the supreme goal of
all theory is to make the irreducible basic elements
as simple and as few as possible without having to
surrender the adequate representation of a single
datum of experience.” — Albert Einstein
.
Check out more examples in test/Main.hs and
look at the results with --enable-tests.
homepage: https://bitbucket.org/dpwiz/xml-conduit-writer
license: MIT
license-file: LICENSE
copyright: Alexander Bondarenko 2013
author: Alexander Bondarenko
maintainer: aenor.realm@gmail.com
category: Text
build-type: Simple
cabal-version: >=1.8
source-repository head
type: git
location: https://bitbucket.org/dpwiz/xml-conduit-writer
library
ghc-options: -Wall -O2
hs-source-dirs: src
exposed-modules:
Text.XML.Writer
build-depends:
base ==4.*,
xml-conduit, xml-types,
text,
mtl, dlist,
containers,
data-default
test-suite tests
type: exitcode-stdio-1.0
main-is: Main.hs
hs-source-dirs: test/
build-depends:
base, xml-conduit-writer, text