Clean-up and migration of Text.Xml.Conduit.Elements

`ppElements' is only used by Network.Xmpp.Xep.InbandRegistration, so I
moved it there for the time-being.

As `elements' is only used in Stream.hs, I moved it there.

`parseElement' is not used anywhere, and was removed completely.

`renderElement' (and its local `elementToEvents' function) is used by
Stream.hs and Concurrent.hs, so I moved it to Utilties.hs. (We could
argue for a separate `Elements' module, but right now that seems
a bit thin. `openElementToEvents' is used by both `elementToEvents'
and `renderOpenElement', so I put both `openElementToEvents' and
`renderOpenElement' in Utilities.hs as well.

`compressNodes' and `streamName' were made where-local to `elements'.

The types were moved to Types.hs.

pontarius-xmpp.cabal

@@ -80,7 +80,6 @@ Library
                , Network.Xmpp.Tls
                , Network.Xmpp.Types
                , Network.Xmpp.Xep.ServiceDiscovery
-               , Text.Xml.Stream.Elements
   GHC-Options: -Wall
 
 Source-Repository head

source/Network/Xmpp/Concurrent.hs

@@ -33,7 +33,6 @@ import           Network.Xmpp.Concurrent.Types
 import           Network.Xmpp.Concurrent.Threads
 import           Network.Xmpp.Marshal
 import           Network.Xmpp.Types
-import           Text.Xml.Stream.Elements
 import           Network
 import           Data.Text as Text
 import           Network.Xmpp.Tls
@@ -43,6 +42,7 @@ import           Network.Xmpp.Sasl.Mechanisms
 import           Network.Xmpp.Sasl.Types
 import           Data.Maybe
 import           Network.Xmpp.Stream
+import           Network.Xmpp.Utilities
 
 import           Control.Monad.Error
 

source/Network/Xmpp/Stream.hs

@@ -25,7 +25,6 @@ import           Data.XML.Types
 import           Network.Xmpp.Types
 import           Network.Xmpp.Marshal
 
-import           Text.Xml.Stream.Elements
 import           Text.XML.Stream.Parse as XP
 import           Control.Concurrent (forkIO, threadDelay)
 
@@ -50,6 +49,9 @@ import           Data.ByteString.Char8 as BSC8
 import           Text.XML.Unresolved(InvalidEventStream(..))
 import qualified Control.Exception.Lifted as ExL
 
+import           Control.Monad.Trans.Resource as R
+import           Network.Xmpp.Utilities
+
 -- import Text.XML.Stream.Elements
 
 -- Unpickles and returns a stream element.
@@ -481,3 +483,48 @@ debugConduit = forever $ do
             liftIO $ BS.putStrLn (BS.append "in: " s)
             yield s
         Nothing -> return ()
+
+elements :: R.MonadThrow m => Conduit Event m Element
+elements = do
+        x <- await
+        case x of
+            Just (EventBeginElement n as) -> do
+                                                 goE n as >>= yield
+                                                 elements
+            Just (EventEndElement streamName) -> lift $ R.monadThrow StreamEnd
+            Nothing -> return ()
+            _ -> lift $ R.monadThrow $ InvalidXmppXml $ "not an element: " ++ show x
+  where
+    many' f =
+        go id
+      where
+        go front = do
+            x <- f
+            case x of
+                Left x -> return $ (x, front [])
+                Right y -> go (front . (:) y)
+    goE n as = do
+        (y, ns) <- many' goN
+        if y == Just (EventEndElement n)
+            then return $ Element n as $ compressNodes ns
+            else lift $ R.monadThrow $ InvalidXmppXml $
+                                         "Missing close tag: " ++ show n
+    goN = do
+        x <- await
+        case x of
+            Just (EventBeginElement n as) -> (Right . NodeElement) <$> goE n as
+            Just (EventInstruction i) -> return $ Right $ NodeInstruction i
+            Just (EventContent c) -> return $ Right $ NodeContent c
+            Just (EventComment t) -> return $ Right $ NodeComment t
+            Just (EventCDATA t) -> return $ Right $ NodeContent $ ContentText t
+            _ -> return $ Left x
+
+    compressNodes :: [Node] -> [Node]
+    compressNodes [] = []
+    compressNodes [x] = [x]
+    compressNodes (NodeContent (ContentText x) : NodeContent (ContentText y) : z) =
+        compressNodes $ NodeContent (ContentText $ x `Text.append` y) : z
+    compressNodes (x:xs) = x : compressNodes xs
+
+    streamName :: Name
+    streamName = (Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream"))

source/Network/Xmpp/Types.hs

@@ -43,6 +43,8 @@ module Network.Xmpp.Types
     , isBare
     , isFull
     , fromString
+    , StreamEnd(..)
+    , InvalidXmppXml(..)
     )
        where
 
@@ -1019,3 +1021,10 @@ resourceprepProfile = SP.Profile { SP.maps = [SP.b1]
                                                    ]
                                  , SP.shouldCheckBidi = True
                                  }
+
+data StreamEnd = StreamEnd deriving (Typeable, Show)
+instance Exception StreamEnd
+
+data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
+
+instance Exception InvalidXmppXml

source/Network/Xmpp/Utilities.hs

@@ -3,7 +3,7 @@
 
 {-# OPTIONS_HADDOCK hide #-}
 
-module Network.Xmpp.Utilities (idGenerator, presTo, message, answerMessage) where
+module Network.Xmpp.Utilities (presTo, message, answerMessage, openElementToEvents, renderOpenElement, renderElement) where
 
 import Network.Xmpp.Types
 
@@ -16,7 +16,24 @@ import Data.XML.Types
 import qualified Data.Attoparsec.Text as AP
 import qualified Data.Text as Text
 
+import qualified Data.ByteString as BS
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import           System.IO.Unsafe(unsafePerformIO)
+import           Data.Conduit.List as CL
+-- import           Data.Typeable
+import           Control.Applicative ((<$>))
+import           Control.Exception
+import           Control.Monad.Trans.Class
+
+import           Data.Conduit as C
+import           Data.XML.Types
+
+import qualified Text.XML.Stream.Render as TXSR
+import           Text.XML.Unresolved as TXU
 
+
+-- TODO: Not used, and should probably be removed.
 -- | Creates a new @IdGenerator@. Internally, it will maintain an infinite list
 -- of IDs ('[\'a\', \'b\', \'c\'...]'). The argument is a prefix to prepend the
 -- IDs with. Calling the function will extract an ID and update the generator's
@@ -39,11 +56,11 @@ idGenerator prefix = atomically $ do
     -- Generates an infinite and predictable list of IDs, all beginning with the
     -- provided prefix. Adds the prefix to all combinations of IDs (ids').
     ids :: Text.Text -> [Text.Text]
-    ids p = map (\ id -> Text.append p id) ids'
+    ids p = Prelude.map (\ id -> Text.append p id) ids'
       where
         -- Generate all combinations of IDs, with increasing length.
         ids' :: [Text.Text]
-        ids' = map Text.pack $ concatMap ids'' [1..]
+        ids' = Prelude.map Text.pack $ Prelude.concatMap ids'' [1..]
         -- Generates all combinations of IDs with the given length.
         ids'' :: Integer -> [String]
         ids'' 0 = [""]
@@ -81,3 +98,29 @@ answerMessage Message{messageFrom = Just frm, ..} payload =
                 , ..
                 }
 answerMessage _ _ = Nothing
+
+openElementToEvents :: Element -> [Event]
+openElementToEvents (Element name as ns) = EventBeginElement name as : goN ns []
+  where
+    goE (Element name' as' ns') =
+          (EventBeginElement name' as' :)
+        . goN ns'
+        . (EventEndElement name' :)
+    goN [] = id
+    goN [x] = goN' x
+    goN (x:xs) = goN' x . goN xs
+    goN' (NodeElement e) = goE e
+    goN' (NodeInstruction i) = (EventInstruction i :)
+    goN' (NodeContent c) = (EventContent c :)
+    goN' (NodeComment t) = (EventComment t :)
+
+renderOpenElement :: Element -> BS.ByteString
+renderOpenElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
+    $ CL.sourceList (openElementToEvents e) $$ TXSR.renderText def =$ CL.consume
+
+renderElement :: Element -> BS.ByteString
+renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
+    $ CL.sourceList (elementToEvents e) $$ TXSR.renderText def =$ CL.consume
+  where
+    elementToEvents :: Element -> [Event]
+    elementToEvents e@(Element name _ _) = openElementToEvents e ++ [EventEndElement name]

source/Network/Xmpp/Xep/InbandRegistration.hs

@@ -202,3 +202,6 @@ instance Read Field where
 
 -- Registered
 -- Instructions
+
+ppElement :: Element -> String
+ppElement = Text.unpack . Text.decodeUtf8 . renderElement

source/Text/Xml/Stream/Elements.hs

@@ -1,108 +0,0 @@
-{-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Text.Xml.Stream.Elements where
-
-import           Control.Applicative ((<$>))
-import           Control.Exception
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Resource as R
-
-import qualified Data.ByteString as BS
-import           Data.Conduit as C
-import           Data.Conduit.List as CL
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Text
-import           Data.Typeable
-import           Data.XML.Types
-
-import           System.IO.Unsafe(unsafePerformIO)
-
-import qualified Text.XML.Stream.Render as TXSR
-import           Text.XML.Unresolved as TXU
-
-compressNodes :: [Node] -> [Node]
-compressNodes [] = []
-compressNodes [x] = [x]
-compressNodes (NodeContent (ContentText x) : NodeContent (ContentText y) : z) =
-    compressNodes $ NodeContent (ContentText $ x `Text.append` y) : z
-compressNodes (x:xs) = x : compressNodes xs
-
-streamName :: Name
-streamName =
-    (Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream"))
-
-data StreamEnd = StreamEnd deriving (Typeable, Show)
-instance Exception StreamEnd
-
-data InvalidXmppXml = InvalidXmppXml String deriving (Show, Typeable)
-
-instance Exception InvalidXmppXml
-
-parseElement txt = documentRoot $ TXU.parseText_ TXU.def txt
-
-elements :: R.MonadThrow m => C.Conduit Event m Element
-elements = do
-        x <- C.await
-        case x of
-            Just (EventBeginElement n as) -> do
-                                                 goE n as >>= C.yield
-                                                 elements
-            Just (EventEndElement streamName) -> lift $ R.monadThrow StreamEnd
-            Nothing -> return ()
-            _ -> lift $ R.monadThrow $ InvalidXmppXml $ "not an element: " ++ show x
-  where
-    many' f =
-        go id
-      where
-        go front = do
-            x <- f
-            case x of
-                Left x -> return $ (x, front [])
-                Right y -> go (front . (:) y)
-    goE n as = do
-        (y, ns) <- many' goN
-        if y == Just (EventEndElement n)
-            then return $ Element n as $ compressNodes ns
-            else lift $ R.monadThrow $ InvalidXmppXml $
-                                         "Missing close tag: " ++ show n
-    goN = do
-        x <- await
-        case x of
-            Just (EventBeginElement n as) -> (Right . NodeElement) <$> goE n as
-            Just (EventInstruction i) -> return $ Right $ NodeInstruction i
-            Just (EventContent c) -> return $ Right $ NodeContent c
-            Just (EventComment t) -> return $ Right $ NodeComment t
-            Just (EventCDATA t) -> return $ Right $ NodeContent $ ContentText t
-            _ -> return $ Left x
-
-
-openElementToEvents :: Element -> [Event]
-openElementToEvents (Element name as ns) = EventBeginElement name as : goN ns []
-  where
-    goE (Element name' as' ns') =
-          (EventBeginElement name' as' :)
-        . goN ns'
-        . (EventEndElement name' :)
-    goN [] = id
-    goN [x] = goN' x
-    goN (x:xs) = goN' x . goN xs
-    goN' (NodeElement e) = goE e
-    goN' (NodeInstruction i) = (EventInstruction i :)
-    goN' (NodeContent c) = (EventContent c :)
-    goN' (NodeComment t) = (EventComment t :)
-
-elementToEvents :: Element -> [Event]
-elementToEvents e@(Element name _ _) = openElementToEvents e ++ [EventEndElement name]
-
-
-renderOpenElement :: Element -> BS.ByteString
-renderOpenElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
-    $ CL.sourceList (openElementToEvents e) $$ TXSR.renderText def =$ CL.consume
-
-renderElement :: Element -> BS.ByteString
-renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
-    $ CL.sourceList (elementToEvents e) $$ TXSR.renderText def =$ CL.consume
-
-ppElement :: Element -> String
-ppElement = Text.unpack . Text.decodeUtf8 . renderElement