packages feed

xml-conduit-writer (empty) → 0.1.0.0

raw patch · 5 files changed

+315/−0 lines, 5 filesdep +basedep +containersdep +dlistsetup-changed

Dependencies added: base, containers, dlist, mtl, text, xml-conduit, xml-conduit-writer, xml-types

Files

+ LICENSE view
@@ -0,0 +1,20 @@+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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/XML/Writer.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}++-- | Overcome XML insanity, node by node.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > let doc = document "root" $ do+-- >     element "hello" "world"+-- >     element "hierarchy" $ do+-- >         element "simple" $ toXML True+-- >         element "as" "it should be"+-- >         toXML $ Just "like this"+-- >     comment "that's it!"+--++module Text.XML.Writer+    (+    -- * Documents+      document, soap+    , pprint+    -- * Elements+    , XML+    -- ** Node creation+    , node+    , instruction+    , comment+    , element, elementA+    , content+    , empty+    , many+    -- ** Element helpers+    , render, (!:)+    -- ** Converting data+    , ToXML(..)+    ) where++import Text.XML+import Control.Monad.Writer.Strict+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++-- | Insert one node+node :: Node -> XML+node = tell . DL.singleton++-- | Insert an "Element" node constructed with name and children.+element :: Name -> XML -> XML+element name children = node . NodeElement $! Element name def (render children)++-- | Insert an "Element" node constructed with name, attributes and children.+elementA :: Name -> [(Name, Text)] -> XML -> XML+elementA name attrs children = node . NodeElement $! Element name (M.fromList attrs) (render 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++-- | Do nothing.+empty :: XML+empty = return ()++-- | Mass-convert to nodes.+-- +-- > let array = element "container" $ many "wrapper" [1..3]+-- +-- Which gives:+-- +-- > <container>+-- >     <wrapper>1</wrapper>+-- >     <wrapper>2</wrapper>+-- >     <wrapper>3</wrapper>+-- > </container>+--+-- 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:+--+-- > <container>chunkychunk</container>+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)
+ test/Main.hs view
@@ -0,0 +1,58 @@+{-# 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" "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" "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.cabal view
@@ -0,0 +1,40 @@+name:                xml-conduit-writer+version:             0.1.0.0+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-monad+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++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++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test/+  build-depends:+    base, xml-conduit-writer, text