[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 15:21:04 UTC 2010
The following commit has been merged in the master branch:
commit 031239d45c496a003e73264c130860f95e669783
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Dec 7 23:19:23 2006 +0100
Remove AnyDBM to be split off
diff --git a/MissingH.cabal b/MissingH.cabal
index c367067..4579594 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -37,9 +37,6 @@ Exposed-Modules: Data.String, System.IO.Utils, System.IO.Binary, Data.List.Utils
System.IO.HVIO, System.IO.StatCompat, System.IO.WindowsCompat,
System.IO.PlafCompat, System.Posix.Consts,
Data.MIME.Types,
- Database.AnyDBM,
- Database.AnyDBM.MapDBM,
- Database.AnyDBM.StringDBM,
System.Console.GetOpt.Utils
Extensions: ExistentialQuantification, OverlappingInstances,
UndecidableInstances, CPP
diff --git a/src/Database/AnyDBM.hs b/src/Database/AnyDBM.hs
deleted file mode 100644
index b5ff734..0000000
--- a/src/Database/AnyDBM.hs
+++ /dev/null
@@ -1,169 +0,0 @@
-{- arch-tag: Generic Dict-Like Object Support
-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 : Database.AnyDBM
- 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
-
-This module provides a generic infrastructure for supporting storage of
-hash-like items with String -> String mappings. It can be used for in-memory
-or on-disk items.
-
--}
-module Database.AnyDBM (-- * The AnyDBM class
- AnyDBM(..),
- -- * AnyDBM utilities
- mapA,
- strFromA, strToA
- )
-where
-import Prelude hiding (lookup)
-import System.IO
-import Data.HashTable
-import Control.Exception
-import Data.List.Utils(strFromAL, strToAL)
-
-{- | The main class for items implementing this interface.
-
-People implementing this class should provide methods for:
-
-* 'closeA' (unless you have no persistent storage)
-
-* 'flushA' (unless you have no persistent storage)
-
-* 'insertA'
-
-* 'deleteA'
-
-* 'lookupA'
-
-* either 'toListA' or 'keysA'
--}
-class AnyDBM a where
- {- | Close the object, writing out any unsaved data to disk if necessary.
-
- If you implement this, make sure your implementation calls 'flushA'.
-
- Note: if you have an object opened for writing, you MUST
- call closeA on it when you are done. Implementations are not
- required to preserve your data otherwise.
- -}
- closeA :: a -> IO ()
-
- {- | Flush the object, saving any un-saved data to disk but not closing
- it. Called automatically by 'closeA'. -}
- flushA :: a -> IO ()
-
- {- | Insert the given data into the map. Existing data with the same key
- will be overwritten. -}
- insertA :: a -- ^ AnyDBM object
- -> String -- ^ Key
- -> String -- ^ Value
- -> IO ()
-
- {- | Delete the data referenced by the given key. It is not an error
- if the key does not exist. -}
- deleteA :: a -> String -> IO ()
-
- {- | True if the given key is present. -}
- hasKeyA :: a -> String -> IO Bool
-
- {- | Find the data referenced by the given key. -}
- lookupA :: a -> String -> IO (Maybe String)
-
- {- | Look up the data and raise an exception if the key does not exist.
- The exception raised is PatternMatchFail, and the string accompanying
- it is the key that was looked up.-}
- forceLookupA :: a -> String -> IO String
-
- {- | Call 'insertA' on each pair in the given association list, adding
- them to the map. -}
- insertListA :: a -> [(String, String)] -> IO ()
-
- {- | Return a representation of the content of the map as a list. -}
- toListA :: a -> IO [(String, String)]
-
- {- | Returns a list of keys in the 'AnyDBM' object. -}
- keysA :: a -> IO [String]
-
- {- | Returns a list of values in the 'AnyDBM' object. -}
- valuesA :: a -> IO [String]
-
- valuesA h = do l <- toListA h
- return $ map snd l
-
- keysA h = do l <- toListA h
- return $ map fst l
-
-
- toListA h =
- let conv k = do v <- forceLookupA h k
- return (k, v)
- in do k <- keysA h
- mapM conv k
-
- forceLookupA h key =
- do x <- lookupA h key
- case x of
- Just y -> return y
- Nothing -> throwIO $ PatternMatchFail key
-
- insertListA h [] = return ()
- insertListA h ((key, val):xs) = do insertA h key val
- insertListA h xs
-
- hasKeyA h k = do l <- lookupA h k
- case l of
- Nothing -> return False
- Just _ -> return True
-
- closeA h = flushA h
-
- flushA h = return ()
-
-{- | Similar to MapM, but for 'AnyDBM' objects. -}
-mapA :: AnyDBM a => a -> ((String, String) -> IO b) -> IO [b]
-mapA h func = do l <- toListA h
- mapM func l
-
-{- | Similar to 'Data.List.Utils.strToAL' -- load a string representation
-into the AnyDBM. You must supply an existing AnyDBM object;
-the items loaded from the string will be added to it. -}
-strToA :: AnyDBM a => a -> String -> IO ()
-strToA h s = insertListA h (strToAL s)
-
-{- | Similar to 'Data.List.Utils.strFromAL' -- get a string representation of
-the entire AnyDBM. -}
-strFromA :: AnyDBM a => a -> IO String
-strFromA h = do l <- toListA h
- return (strFromAL l)
-
-instance AnyDBM (HashTable String String) where
- insertA h k v = do delete h k
- insert h k v
- deleteA = delete
- lookupA = lookup
- toListA = toList
-
diff --git a/src/Database/AnyDBM/MapDBM.hs b/src/Database/AnyDBM/MapDBM.hs
deleted file mode 100644
index 0f89050..0000000
--- a/src/Database/AnyDBM/MapDBM.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-
-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 : Database.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 "Database.AnyDBM" framework.
--}
-
-module Database.AnyDBM.MapDBM (MapDBM,
- newMapDBM,
- setMapDBM,
- getMapDBM
- )
-where
-import Database.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 Map in this 'MapDBM'. -}
-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/src/Database/AnyDBM/StringDBM.hs b/src/Database/AnyDBM/StringDBM.hs
deleted file mode 100644
index afbe579..0000000
--- a/src/Database/AnyDBM/StringDBM.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{- arch-tag: Support for persistent storage through strings
-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 : Database.AnyDBM.StringDBM
- 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
-
-This 'Database.AnyDBM.AnyDBM' implementation is very simple. It can store
-data on-disk in a persistent fashion, using a very simple String
-representation. While the file is open, an in-memory cache is maintained.
-The data is written out during a call to 'flush' or 'close'.
--}
-
-module Database.AnyDBM.StringDBM (StringDBM,
- openStringDBM,
- openStringVDBM,
- SystemFS(..),
- IOMode(..)
- )
-where
-import Database.AnyDBM
-import System.IO
-import System.IO.HVFS
-import System.IO.HVIO
-import Data.HashTable
-import Control.Concurrent.MVar
-
-{- | The type of the StringDBM instances. -}
-data StringDBM = forall a. HVFSOpenable a => StringDBM (MVar ()) (HashTable String String) IOMode a FilePath
-
-{- | Opens a 'StringDBM' file. Please note: only ReadMode, WriteMode,
-and ReadWriteMode are supported for the IOMode. AppendMode is not supported.
-
->openStringDBM = openStringVDBM SystemFS
--}
-openStringDBM :: FilePath -> IOMode -> IO StringDBM
-openStringDBM = openStringVDBM SystemFS
-
-{- | Opens a 'StringDBM' file. Please note: only ReadMode, WriteMode,
-and ReadWriteMode are supported for the IOMode. AppendMode is not supported.
-
-To work on your system's normal (real) filesystem, just specify
-'SystemFS' for the first argument.
--}
-openStringVDBM :: HVFSOpenable a => a -> FilePath -> IOMode -> IO StringDBM
-openStringVDBM _ _ AppendMode = fail "openStringDBM: AppendMode is not supported"
-openStringVDBM h fp ReadMode =
- do ht <- new (==) hashString
- lock <- newMVar ()
- vReadFile h fp >>= strToA ht
- return $ StringDBM lock ht ReadMode h fp
-openStringVDBM h fp WriteMode =
- do ht <- new (==) hashString
- lock <- newMVar ()
- return $ StringDBM lock ht WriteMode h fp
-openStringVDBM h fp ReadWriteMode =
- -- Nothing different to start with. Later, we emulate WriteMode.
- -- Nothing is ever read after the object is created.
- do ht <- new (==) hashString
- lock <- newMVar ()
- d <- vDoesFileExist h fp
- if d
- then vReadFile h fp >>= strToA ht
- else return ()
- return $ StringDBM lock ht WriteMode h fp
-
-g :: StringDBM -> HashTable String String
-g (StringDBM _ ht _ _ _) = ht
-
-instance AnyDBM StringDBM where
- flushA (StringDBM lock ht WriteMode h fp) = withMVar lock $ \_ ->
- do s <- strFromA ht
- vWriteFile h fp s
- flushA _ = return ()
-
- insertA = insertA . g
- deleteA = deleteA . g
- lookupA = lookupA . g
- toListA = toListA . g
diff --git a/testsrc/AnyDBMtest.hs b/testsrc/AnyDBMtest.hs
deleted file mode 100644
index 1fbb48c..0000000
--- a/testsrc/AnyDBMtest.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-{- arch-tag: AnyDBM tests main file
-Copyright (C) 2004-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 AnyDBMtest(mf, generic_persist_test, generic_test, tests) where
-import Test.HUnit
-import Data.List.Utils
-import System.IO.HVFS
-import System.IO.HVFS.InstanceHelpers
-import Database.AnyDBM
-import Database.AnyDBM.StringDBM
-import Database.AnyDBM.MapDBM
-import System.Directory
-import System.IO.HVFS.Utils
-import System.FilePath
-import Data.HashTable
-import Data.List(sort)
-import Control.Exception(finally)
-
-mf :: AnyDBM a => IO b -> (b -> IO a) -> String -> (a -> Assertion) -> Test
-mf initfunc openfunc msg code =
- TestLabel msg $ TestCase $ do i <- initfunc
- h <- openfunc i
- finally (code h) (closeA h)
-
-infix 1 @>=?
-(@>=?) :: (Eq a, Show a) => a -> IO a -> Assertion
-(@>=?) exp res = do r <- res
- exp @=? r
-
-deleteall h = do k <- keysA h
- mapM_ (deleteA h) k
- [] @>=? keysA h
-
-weirdl = sort $ [("", "empty"),
- ("foo\nbar", "v1\0v2"),
- ("v3,v4", ""),
- ("k\0ey", "\xFF")]
-
-createdir = TestCase $ createDirectory "testtmp"
-removedir = TestCase $ recursiveRemove SystemFS "testtmp"
-
-generic_test initfunc openfunc =
- let f = mf initfunc openfunc in
- [
- createdir
- ,f "empty" $ \h -> do [] @>=? keysA h
- [] @>=? valuesA h
- [] @>=? toListA h
- Nothing @>=? lookupA h "foo"
-
- ,f "basic" $ \h -> do insertA h "key" "value"
- (Just "value") @>=? lookupA h "key"
- [("key", "value")] @>=? toListA h
- insertA h "key" "v2"
- [("key", "v2")] @>=? toListA h
- deleteA h "key"
- [] @>=? toListA h
- ,f "mult" $ \h -> do insertListA h [("1", "2"), ("3", "4"), ("5", "6")]
- [("1", "2"), ("3", "4"), ("5", "6")] @>=?
- (toListA h >>= return . sort)
- ["1", "3", "5"] @>=? (keysA h >>= return . sort)
- ["2", "4", "6"] @>=? (valuesA h >>= return . sort)
- deleteall h
- ,f "weirdchars" $ \h -> do insertListA h weirdl
- weirdl @>=? (toListA h >>= return . sort)
- deleteall h
- ,removedir
- ]
-
-generic_persist_test initfunc openfunc =
- let f = mf initfunc openfunc in
- [
- createdir
- ,f "empty" deleteall
- ,f "weirdpop" $ \h -> insertListA h weirdl
- ,f "weirdcheck" $ \h -> do weirdl @>=? (toListA h >>= return . sort)
- deleteall h
- insertA h "key" "value"
- ,f "step3" $ \h -> do [("key", "value")] @>=? (toListA h >>= return . sort)
- insertA h "key" "v2"
- insertA h "z" "y"
- ,f "step4" $ \h -> do [("key", "v2"), ("z", "y")] @>=?
- (toListA h >>= return . sort)
- ,f "cleanupdb" deleteall
- ,removedir
- ]
-
-test_hashtable = generic_test (return ())
- (\_ -> ((new (==) hashString)::IO (HashTable String String)))
-
-test_mapdbm = generic_test (return ())
- (\_ -> newMapDBM)
-test_stringdbm = generic_persist_test (return SystemFS)
- (\f -> openStringVDBM f (joinPath ["testtmp", "StringDBM"]) ReadWriteMode)
- ++
- generic_test (return SystemFS)
- (\f -> openStringVDBM f (joinPath ["testtmp", "StringDBM"]) ReadWriteMode)
-
-tests = TestList [TestLabel "HashTable" (TestList test_hashtable),
- TestLabel "StringDBM" (TestList test_stringdbm),
- TestLabel "MapDBM" (TestList test_mapdbm)
- ]
diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs
index e4defd4..91c47dd 100644
--- a/testsrc/Tests.hs
+++ b/testsrc/Tests.hs
@@ -21,7 +21,6 @@ import Test.HUnit
import qualified MIMETypestest
import qualified Listtest
import qualified Maptest
-import qualified AnyDBMtest
import qualified Pathtest
import qualified Strtest
import qualified IOtest
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list