content: {-# LANGUAGE DeriveDataTypeable #-}
  
  -- ------------------------------------------------------------
  
  {- |
     Module     : Data.Atom
     Copyright  : Copyright (C) 2008 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
     Stability  : experimental
     Portability: non-portable
  
     Unique Atoms generated from Strings and
     managed as flyweights
  
     Data.Atom can be used for caching and storage optimization
     of frequently used strings. An @Atom@ is constructed from a @String@.
     For two equal strings the identical atom is returned.
  
     This module can be used for optimizing memory usage when working with
     strings or names. Many applications use data types like
     @Map String SomeAttribute@ where a rather fixed set of keys is used.
     Especially XML applications often work with a limited set of element and attribute names.
     For these applications it becomes more memory efficient when working with types like
     @Map Atom SomeAttribute@ and convert the keys into atoms before operating
     on such a map.
  
     Internally this module manages a map of atoms. The atoms are internally represented
     by @ByteString@s. When creating a new atom from a string, the string is first converted
     into an UTF8 @Word8@ sequence, which is packed into a @ByteString@. This @ByteString@ is looked
     up in the table of atoms. If it is already there, the value in the map is used as atom, else
     the new @ByteString@ is inserted into the map.
  
     Of course the implementation of this name cache uses @unsavePerformIO@.
     The global cache is managed by ue of an @IORef@ and atomicModifyIORef.
  
     The following laws hold for atoms
  
     >
     > s  ==       t => newAtom s  ==       newAtom t
     > s `compare` t => newAtom s `compare` newAtom t
     > show . newAtom == id
  
     Equality test for @Atom@s runs in /O(1)/, it is just a pointer comparison.
     The @Ord@ comparisons have the same runtime like the @ByteString@ comparisons.
     Internally there is an UTF8 comparison, but UTF8 encoding preserves the total order.
  
     Warning: The internal cache never shrinks during execution. So using it in a
     undisciplined way can lead to memory leaks.
  -}
  
  -----------------------------------------------------------------------------
  
  module Data.Atom (
     -- * Atom objects
     Atom,                -- instance (Eq, Ord, Read, Show)
     newAtom,             -- :: String -> Atom
     share                -- :: String -> String
   ) where
  
  import           Control.DeepSeq
  
  import           Data.ByteString          (ByteString, pack, unpack)
  import           Data.ByteString.Internal (c2w, toForeignPtr, w2c)
  import           Data.IORef
  import qualified Data.Map                 as M
  import           Data.String.Unicode      (unicodeToUtf8)
  import           Data.String.UTF8Decoding (decodeUtf8)
  import           Data.Typeable
  
  import           System.IO.Unsafe         (unsafePerformIO)
  
  -- ------------------------------------------------------------
  
  type Atoms      = M.Map ByteString ByteString
  
  newtype Atom    = A { bs :: ByteString }
                    deriving (Typeable)
  
  -- ------------------------------------------------------------
  
  -- | the internal cache for the strings
  
  theAtoms        :: IORef Atoms
  theAtoms        = unsafePerformIO (newIORef M.empty)
  {-# NOINLINE theAtoms #-}
  
  -- | insert a bytestring into the atom cache
  
  insertAtom      :: ByteString -> Atoms -> (Atoms, Atom)
  insertAtom s m  = maybe (M.insert s s m, A s)
                          (\ s' -> (m, A s'))
                    .
                    M.lookup s $ m
  
  -- | creation of an @Atom@ from a @String@
  
  newAtom         :: String -> Atom
  newAtom         = unsafePerformIO . newAtom'
  {-# NOINLINE newAtom #-}
  
  -- | The internal operation running in the IO monad
  newAtom'        :: String -> IO Atom
  newAtom' s      = do
                    -- putStrLn "insert atom into cache"
                    res <- atomicModifyIORef theAtoms insert
                    -- putStrLn "atom cache updated"
                    return res
    where
      insert m    = let r = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m
                    in
                     fst r `seq` r
  
  -- | Insert a @String@ into the atom cache and convert the atom back into a @String@.
  --
  -- locically @share == id@ holds, but internally equal strings share the same memory.
  
  share           :: String -> String
  share           = show . newAtom
  
  instance Eq Atom where
      a1 == a2    = fp1 == fp2
                    where
                    (fp1, _, _) = toForeignPtr . bs $ a1
                    (fp2, _, _) = toForeignPtr . bs $ a2
  
  instance Ord Atom where
      compare a1 a2
                  | a1 == a2      = EQ
                  | otherwise     = compare (bs a1) (bs a2)
  
  instance Read Atom where
      readsPrec p str = [ (newAtom x, y) | (x, y) <- readsPrec p str ]
  
  instance Show Atom where
      show        = fst . decodeUtf8 . map w2c . unpack . bs
      -- show     = show . toForeignPtr . bs                      -- for debug only
  
  instance NFData Atom where
      rnf x = seq x ()
  
  -----------------------------------------------------------------------------
  