hxt 9.1.1 → 9.1.2

raw patch · 3 files changed

+36/−29 lines, 3 filesdep ~hxt-unicodePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hxt-unicode

API changes (from Hackage documentation)

Files

• hxt.cabal +5/−5
• src/Data/Atom.hs +13/−9
• src/Text/XML/HXT/DOM/QualifiedName.hs +18/−15

@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name:           hxt-Version:        9.1.1+Version:        9.1.2 Synopsis:       A collection of tools for processing XML with Haskell. Description:    The Haskell XML Toolbox bases on the ideas of HaXml and HXML,                 but introduces a more general approach for processing XML with Haskell.@@ -15,7 +15,7 @@                 hxt-curl, hxt-tagsoup, hxt-relaxng, hxt-xpath, hxt-xslt, hxt-regex-xmlschema contain the extensions.                 hxt-unicode contains encoding and decoding functions,                 hxt-charproperties char properties for unicode and XML.-License:        OtherLicense+License:        MIT License-file:   LICENSE Author:         Uwe Schmidt, Martin Schmidt, Torben Kuseler Maintainer:     Uwe Schmidt <uwe@fh-wedel.de>@@ -176,6 +176,6 @@                 deepseq    >= 1.1 && < 2,                 bytestring >= 0.9 && < 1,                 binary     >= 0.5 && < 1,-                hxt-charproperties  >= 9.1 && < 10,-                hxt-unicode         >= 9   && < 10,-                hxt-regex-xmlschema >= 9   && < 10+                hxt-charproperties  >= 9.1    && < 10,+                hxt-unicode         >= 9.0.1  && < 10,+                hxt-regex-xmlschema >= 9      && < 10

@@ -32,8 +32,8 @@    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@ and @MVar@s-   for managing this kind of global state.+   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 @@ -59,11 +59,11 @@    share                -- :: String -> String  ) where -import           Control.Concurrent.MVar import           Control.DeepSeq  import           Data.ByteString.Internal       ( toForeignPtr, c2w, w2c ) import           Data.ByteString                ( ByteString, pack, unpack )+import           Data.IORef import qualified Data.Map                       as M import           Data.String.UTF8Decoding       ( decodeUtf8 ) import           Data.String.Unicode            ( unicodeToUtf8 )@@ -82,8 +82,8 @@  -- | the internal cache for the strings -theAtoms        :: MVar Atoms-theAtoms        = unsafePerformIO (newMVar M.empty)+theAtoms        :: IORef Atoms+theAtoms        = unsafePerformIO (newIORef M.empty) {-# NOINLINE theAtoms #-}  -- | insert a bytestring into the atom cache@@ -103,10 +103,14 @@ -- | The internal operation running in the IO monad newAtom'        :: String -> IO Atom newAtom' s      = do-                  m <- takeMVar theAtoms-                  let (m', a) = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m-                  putMVar theAtoms m'-                  return a+                  -- 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@. --

@@ -84,13 +84,13 @@  import           Control.Arrow                  ( (***) ) -import           Control.Concurrent.MVar import           Control.DeepSeq import           Control.FlatSeq  import           Data.AssocList import           Data.Binary import           Data.Char                      ( toLower )+import           Data.IORef import           Data.List                      ( isPrefixOf ) import qualified Data.Map               as M import           Data.Typeable@@ -354,11 +354,11 @@  mkNsName                          :: String -> String -> QName mkNsName n ns-    | null ns			= qn-    | otherwise			= setNamespaceUri' ns' qn+    | null ns                   = qn+    | otherwise                 = setNamespaceUri' ns' qn     where     qn                          = mkName n-    ns'				= newXName ns+    ns'                         = newXName ns  -- ------------------------------------------------------------ @@ -512,8 +512,8 @@  -- | the internal cache for QNames (and name strings) -theNameCache            :: MVar NameCache-theNameCache            = unsafePerformIO (newMVar $ initialCache)+theNameCache            :: IORef NameCache+theNameCache            = unsafePerformIO (newIORef $ initialCache) {-# NOINLINE theNameCache #-}  initialXNames           :: [XName]@@ -556,14 +556,17 @@ changeNameCache         :: NFData r => ChangeNameCache r -> r changeNameCache action  = unsafePerformIO changeNameCache'     where-    changeNameCache'    = do-                          -- putStrLn "takeMVar"-                          c <- takeMVar theNameCache-                          let (c', res) = action c-                          c' `seq` -- rnf res `seq`-                             putMVar theNameCache c'-                          -- putStrLn "putMVar"-                          return res+    action' c = +      let r = action c +      in +       fst r `seq` r    -- eval name cache to whnf+       +    changeNameCache' = +      do+      -- putStrLn "modify cache"+      res <- atomicModifyIORef theNameCache action'+      -- putStrLn "cache modified"+      return res  {-# NOINLINE changeNameCache #-} @@ -599,7 +602,7 @@                           newXName' n  newQName                :: XName -> XName -> XName -> QName-newQName lp px ns       = lp `seq` px `seq` ns `seq`                    -- XNames must be evaluated, else MVar blocks+newQName lp px ns       = lp `seq` px `seq` ns `seq`            -- XNames must be evaluated, else MVar blocks                           ( changeNameCache $                             newQName' lp px ns                           )