[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 6a9ce3707b9cd7049165aaf8424b70cbc8c4de64
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 27 02:47:51 2005 +0100

    Added MissingH.AnyDBM.MapDBM
    
    More work to support Data.Map.
    Added this module, tests for it, and lines for it in README and cabal.

diff --git a/MissingH.cabal b/MissingH.cabal
index 3330b7f..0cc034e 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -76,6 +76,7 @@ Exposed-Modules: MissingH.Str, MissingH.IO, MissingH.IO.Binary, MissingH.List,
     MissingH.Wash.Utility.Unique,
   MissingH.AnyDBM,
     MissingH.AnyDBM.FiniteMapDBM,
+    MissingH.AnyDBM.MapDBM,
     MissingH.AnyDBM.StringDBM,
   MissingH.GetOpt
 Extensions: ExistentialQuantification, AllowOverlappingInstances,
diff --git a/MissingH/AnyDBM/MapDBM.hs b/MissingH/AnyDBM/MapDBM.hs
new file mode 100644
index 0000000..a66b4ad
--- /dev/null
+++ b/MissingH/AnyDBM/MapDBM.hs
@@ -0,0 +1,65 @@
+{-
+Copyright (C) 2005 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- |
+   Module     : MissingH.AnyDBM.MapDBM
+   Copyright  : Copyright (C) 2005 John Goerzen
+   License    : GNU GPL, version 2 or above
+
+   Maintainer : John Goerzen <jgoerzen at complete.org>
+   Stability  : provisional
+   Portability: portable
+
+Written by John Goerzen, jgoerzen\@complete.org
+
+Support for working with Maps through the "MissingH.AnyDBM" framework.
+-}
+
+module MissingH.AnyDBM.MapDBM (MapDBM,
+                               newMapDBM,
+                               setMapDBM,
+                               getMapDBM
+                                    )
+where
+import MissingH.AnyDBM
+import Data.Map as Map
+import Control.Concurrent.MVar
+
+{- | The type of the MapDBM. -}
+type MapDBM = MVar (Map.Map String String)
+
+{- | Makes a new MapDBM with an empty Map. -}
+newMapDBM :: IO MapDBM
+newMapDBM = newMVar Map.empty
+
+{- | Sets the embedded Map in this 'MapDBM' to the
+given 'Map'. -}
+setMapDBM :: MapDBM -> Map.Map String String -> IO ()
+setMapDBM h fm = swapMVar h fm >> return ()
+
+{- | Gets the embedded FiniteMap in this 'FiniteMapDBM'. -}
+getMapDBM :: MapDBM -> IO (Map.Map String String)
+getMapDBM = readMVar
+
+m = modifyMVar_
+
+instance AnyDBM MapDBM where
+    insertA h k v = m h (\x -> return $ Map.insert k v x)
+    deleteA h k = m h (\x -> return $ Map.delete k x)
+    lookupA h k = withMVar h (\x -> return $ Map.lookup k x)
+    toListA h = withMVar h (\x -> return $ Map.toList x)
diff --git a/README b/README
index b81762d..76a91c0 100644
--- a/README
+++ b/README
@@ -60,6 +60,9 @@ MissingH.AnyDBM           * Generic DBM-like database infrastructure
 MissingH.AnyDBM.          * Use a FiniteMap in the AnyDBM interface
  FiniteMapDBM
 
+MissingH.AnyDBM.          * Use a Map in the AnyDBM interface
+ MapDBM
+
 MissingH.AnyDBM.          * Simple persistent mapping storage
  StringDBM
 
diff --git a/testsrc/AnyDBMtest.hs b/testsrc/AnyDBMtest.hs
index 1f960b4..7258b61 100644
--- a/testsrc/AnyDBMtest.hs
+++ b/testsrc/AnyDBMtest.hs
@@ -24,6 +24,7 @@ import MissingH.IO.HVFS.InstanceHelpers
 import MissingH.AnyDBM
 import MissingH.AnyDBM.StringDBM
 import MissingH.AnyDBM.FiniteMapDBM
+import MissingH.AnyDBM.MapDBM
 import System.Directory
 import MissingH.IO.HVFS.Utils
 import MissingH.Path.FilePath
@@ -105,6 +106,8 @@ test_hashtable = generic_test (return ())
 
 test_finitemap = generic_test (return ())
                   (\_ -> newFiniteMapDBM)
+test_mapdbm = generic_test (return ())
+                  (\_ -> newMapDBM)
 test_stringdbm = generic_persist_test (return SystemFS)
                    (\f -> openStringVDBM f (joinPaths "testtmp" "StringDBM") ReadWriteMode)
                  ++
@@ -113,5 +116,6 @@ test_stringdbm = generic_persist_test (return SystemFS)
 
 tests = TestList [TestLabel "HashTable" (TestList test_hashtable),
                   TestLabel "StringDBM" (TestList test_stringdbm),
-                  TestLabel "FiniteMap" (TestList test_finitemap)
+                  TestLabel "FiniteMap" (TestList test_finitemap),
+                  TestLabel "MapDBM" (TestList test_mapdbm)
                  ]

-- 
haskell-testpack