From 7487b1ab3bfab8a54469e0e6c6155dfd622eca16 Mon Sep 17 00:00:00 2001
From: Jon Kristensen <jon.kristensen@nejla.com>
Date: Sat, 21 Apr 2012 17:41:56 +0200
Subject: [PATCH] rewrote the id generation code to adhere to the IdGenerator
 newtype used in Types.hs, and to use stm and (for the most part) Text

---
 src/Network/XMPP/Utilities.hs | 114 +++++++++-------------------------
 1 file changed, 31 insertions(+), 83 deletions(-)

diff --git a/src/Network/XMPP/Utilities.hs b/src/Network/XMPP/Utilities.hs
index 8e53b7c..794fe0f 100644
--- a/src/Network/XMPP/Utilities.hs
+++ b/src/Network/XMPP/Utilities.hs
@@ -1,64 +1,57 @@
--- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the
--- Pontarius distribution for more details.
+-- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the Pontarius
+-- distribution for more details.
 
--- This module currently converts XML elements to strings.
-
--- TODO: Use -fno-cse? http://cvs.haskell.org/Hugs/pages/libraries/base/System-IO-Unsafe.html
--- TODO: Remove elementsToString?
+-- TODO: More efficient to use Text instead of Strings for ID generation?
 
 {-# OPTIONS_HADDOCK hide #-}
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Network.XMPP.Utilities ( idGenerator
-                              , nextId
-  -- elementToString
-                              -- , elementsToString ) where
-  ) where
+module Network.XMPP.Utilities (idGenerator) where
 
 import Network.XMPP.Types
 
-import Prelude hiding (concat)
-
-import Data.ByteString (ByteString, concat)
-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 Control.Monad.STM
+import Control.Concurrent.STM.TVar
+import Prelude
 
-import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Text as Text
 
 
 -- |
--- Creates a new stanza "IdGenerator". Internally, it will maintain an infinite
--- list of stanza IDs ('[\'a\', \'b\', \'c\'...]').
+-- 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
+-- 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
-    -- beginning with the provided prefix.
+    -- Transactionally extract the next ID from the infinite list of IDs.
     
-    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' = concatMap ids'' [1..]
+        ids' :: [Text.Text]
+        ids' = map Text.pack $ concatMap ids'' [1..]
 
         -- Generates all combinations of IDs with the given length.
         ids'' :: Integer -> [String]
@@ -67,49 +60,4 @@ 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 []
+        repertoire = ['a'..'z']
\ No newline at end of file