Merge branch 'master' of https://github.com/nejla/pontarius

src/Network/XMPP/Utilities.hs

@@ -1,64 +1,57 @@
--- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the
+-- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the Pontarius
--- Pontarius distribution for more details.
+-- distribution for more details.
 
--- This module currently converts XML elements to strings.
+-- TODO: More efficient to use Text instead of Strings for ID generation?
-
--- TODO: Use -fno-cse? http://cvs.haskell.org/Hugs/pages/libraries/base/System-IO-Unsafe.html
--- TODO: Remove elementsToString?
 
 {-# OPTIONS_HADDOCK hide #-}
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Network.XMPP.Utilities ( idGenerator
+module Network.XMPP.Utilities (idGenerator) where
-                              , nextId
-  -- elementToString
-                              -- , elementsToString ) where
-  ) where
 
 import Network.XMPP.Types
 
-import Prelude hiding (concat)
+import Control.Monad.STM
-
+import Control.Concurrent.STM.TVar
-import Data.ByteString (ByteString, concat)
+import Prelude
-import Data.ByteString.Char8 (unpack)
-
-import Data.Enumerator (($$), Stream (Chunks), Enumerator, Step (Continue), joinI, run_, returnI)
-import Data.Enumerator.List (consume)
-
-import Data.XML.Types (Document (..), Element (..), Event (..), Name (..), Prologue (..))
-
-import Data.IORef (atomicModifyIORef, newIORef)
-
-
--- import Text.XML.Enumerator.Render (renderBytes)
--- import Text.XML.Enumerator.Document (toEvents)
 
-import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Text as Text
 
 
 -- |
--- Creates a new stanza "IdGenerator". Internally, it will maintain an infinite
+-- Creates a new @IdGenerator@. Internally, it will maintain an infinite list of
--- list of stanza IDs ('[\'a\', \'b\', \'c\'...]').
+-- 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
+-- internal state so that the same ID will not be generated again.
 
-idGenerator :: String -> IO IdGenerator
+idGenerator :: Text.Text -> IO IdGenerator
 
-idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IdGenerator ioRef
+idGenerator prefix = atomically $ do
+    tvar <- newTVar $ ids prefix
+    return $ IdGenerator $ next tvar
 
   where
 
-    -- Generates an infinite and predictable list of IDs, all
+    -- Transactionally extract the next ID from the infinite list of IDs.
-    -- beginning with the provided prefix.
     
-    ids :: String -> [String]
+    next :: TVar [Text.Text] -> IO Text.Text
+    next tvar = atomically $ do
+        list <- readTVar tvar
+        writeTVar tvar $ tail list
+        return $ head list
+
+    -- Generates an infinite and predictable list of IDs, all beginning with the
+    -- provided prefix.
+    
+    ids :: Text.Text -> [Text.Text]
 
     -- Adds the prefix to all combinations of IDs (ids').
-    ids p = map (\ id -> p ++ id) ids'
+    ids p = map (\ id -> Text.append p id) ids'
       where
         
         -- Generate all combinations of IDs, with increasing length.
-        ids' :: [String]
+        ids' :: [Text.Text]
-        ids' = concatMap ids'' [1..]
+        ids' = map Text.pack $ concatMap ids'' [1..]
 
         -- Generates all combinations of IDs with the given length.
         ids'' :: Integer -> [String]
@@ -68,48 +61,3 @@ idGenerator p = newIORef (ids p) >>= \ ioRef -> return $ IdGenerator ioRef
         -- Characters allowed in IDs.
         repertoire :: String
         repertoire = ['a'..'z']
-
-
-
--- |
--- Extracts an ID from the "IDGenerator", and updates the generators internal
--- state so that the same ID will not be generated again.
-
-nextId :: IdGenerator -> IO String
-
-nextId g = let IdGenerator ioRef = g
-           in atomicModifyIORef ioRef (\ (i:is) -> (is, i))
-
-
-
--- Converts the Element objects to a document, converts it into Events, strips
--- the DocumentBegin event, generates a ByteString, and converts it into a
--- String, aggregates the results and returns a string.
-
--- elementsToString :: [Element] -> String
-
--- elementsToString [] = ""
--- elementsToString (e:es) = (elementToString (Just e)) ++ (elementsToString es)
-
-
--- Converts the Element object to a document, converts it into Events, strips
--- the DocumentBegin event, generates a ByteString, and converts it into a
--- String.
-
--- {-# NOINLINE elementToString #-}
-
--- elementToString :: Maybe Element -> String
-
--- elementToString Nothing = ""
--- elementToString (Just elem) = unpack $ concat $ unsafePerformIO $ do
---     r <- run_ $ events $$ (joinI $ renderBytes $$ consume)
---     return r
---     where
-
-        -- Enumerator that "produces" the events to convert to the document
---         events :: Enumerator Event IO [ByteString]
---         events (Continue more) = more $ Chunks (tail $ toEvents $ dummyDoc elem)
---         events step = returnI step
-
---         dummyDoc :: Element -> Document
---         dummyDoc e = Document (Prologue [] Nothing []) elem []