[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 14:54:38 UTC 2010
The following commit has been merged in the master branch:
commit 3dc7ed46f1a448324b9c0840fd7fce57a7b666c8
Author: John Goerzen <jgoerzen at complete.org>
Date: Wed Feb 2 04:22:19 2005 +0100
Adding AnyDBM features
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.7--patch-182)
diff --git a/ChangeLog b/ChangeLog
index c349607..d0cd2c3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,22 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
#
+2005-02-01 21:22:19 GMT John Goerzen <jgoerzen at complete.org> patch-182
+
+ Summary:
+ Adding AnyDBM features
+ Revision:
+ missingh--head--0.7--patch-182
+
+
+ new files:
+ libsrc/MissingH/AnyDBM.hs
+
+ modified files:
+ ChangeLog Makefile MissingH.cabal libsrc/MissingH/FiniteMap.hs
+ libsrc/MissingH/List.hs testsrc/Listtest.hs
+
+
2005-01-28 17:43:43 GMT John Goerzen <jgoerzen at complete.org> patch-181
Summary:
diff --git a/Makefile b/Makefile
index cbdcde4..ccc58b7 100644
--- a/Makefile
+++ b/Makefile
@@ -38,6 +38,7 @@ libmissingH.a: $(OBJS)
%.o: %.lhs
ghc -fallow-overlapping-instances -fallow-undecidable-instances -fglasgow-exts -ilibsrc --make `echo $< | sed -e s,libsrc/,, -e s,.lhs$$,, -e s,/,.,g`
+.PHONY: doc
doc:
-rm -rf html
mkdir html
diff --git a/MissingH.cabal b/MissingH.cabal
index ee55654..f064571 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -65,7 +65,8 @@ Exposed-Modules: MissingH.IO, MissingH.IO.Binary, MissingH.List,
MissingH.Wash.Utility.Shell,
MissingH.Wash.Utility.SimpleParser,
MissingH.Wash.Utility.URLCoding,
- MissingH.Wash.Utility.Unique
+ MissingH.Wash.Utility.Unique,
+ MissingH.AnyDBM
HS-Source-Dir: libsrc
Extensions: ExistentialQuantification, AllowOverlappingInstances,
AllowUndecidableInstances
diff --git a/libsrc/MissingH/AnyDBM.hs b/libsrc/MissingH/AnyDBM.hs
new file mode 100644
index 0000000..104715f
--- /dev/null
+++ b/libsrc/MissingH/AnyDBM.hs
@@ -0,0 +1,136 @@
+{- 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 : MissingH.AnyDBM
+ Copyright : Copyright (C) 2005 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen,
+ Maintainer : 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 MissingH.AnyDBM (-- * The AnyDBM class
+ AnyDBM(..),
+ -- * AnyDBM utilities
+ keysA, valuesA, mapA
+ )
+where
+import Prelude hiding (lookup)
+import System.IO
+import Data.HashTable
+import Control.Exception
+
+{- | The main class for items implementing this interface.
+
+People implementing this class should provide methods for everything
+except 'insertListA' and 'forceLookupA'. Classes that have no on-disk
+representation need not implement 'closeA' and 'flushA'. -}
+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'.
+ -}
+ 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 ()
+
+ {- | 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)]
+
+ 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
+
+ closeA h = flushA h
+
+ flushA h = return ()
+
+{- | Returns a list of keys in the 'AnyDBM' object.
+
+The implementation is:
+
+>keysA h = do l <- toListA h
+> return $ map fst l
+
+ -}
+keysA :: AnyDBM a => a -> IO [String]
+keysA h = do l <- toListA h
+ return $ map fst l
+
+{- | Returns a list of values in the 'AnyDBM' object.
+
+The implementation is:
+
+>valuesA h = do l <- toListA h
+> return $ map snd l
+-}
+valuesA :: AnyDBM a => a -> IO [String]
+valuesA h = do l <- toListA h
+ return $ map snd l
+
+{- | 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
+
+instance AnyDBM (HashTable String String) where
+ insertA = insert
+ deleteA = delete
+ lookupA = lookup
+ toListA = toList
+
\ No newline at end of file
diff --git a/libsrc/MissingH/FiniteMap.hs b/libsrc/MissingH/FiniteMap.hs
index 1b3275f..a40329a 100644
--- a/libsrc/MissingH/FiniteMap.hs
+++ b/libsrc/MissingH/FiniteMap.hs
@@ -34,11 +34,41 @@ In addition to the functions exported, this module also makes a FiniteMap
showable.
-}
-module MissingH.FiniteMap (flipFM, flippedLookupFM, forceLookupFM)
+module MissingH.FiniteMap (-- * Basic Utilities
+ flipFM, flippedLookupFM, forceLookupFM,
+ -- * Conversions
+ strToFM,
+ strFromFM
+ )
where
import Data.FiniteMap
-import MissingH.List(flipAL)
+import MissingH.List(flipAL, strToAL, strFromAL)
+
+{- | Converts a String, String FiniteMap into a string representation.
+See 'MissingH.List.strFromAL' for more on the similar function for
+association lists. This implementation is simple:
+
+>strFromFM = strFromAL . fmToList
+
+This function is designed to work with FiniteMap String String objects,
+but may also work with other objects with simple representations. -}
+strFromFM :: (Show a, Show b, Ord a) => FiniteMap a b -> String
+strFromFM = strFromAL . fmToList
+
+{- | Converts a String into a String, String FiniteMap. See
+'MissingH.List.strToAL' for more on the similar function for association
+lists.
+
+This implementation is simple:
+
+>strToFM = listToFM . strToAL
+
+This function is designed to work with FiniteMap String String objects,
+but may work with other key\/value combinations if they have simple
+representations. -}
+strToFM :: (Read a, Read b, Ord a) => String -> FiniteMap a b
+strToFM = listToFM . strToAL
{- | Flips a finite map. See 'MissingH.List.flipAL' for more on the similar
function for lists. -}
diff --git a/libsrc/MissingH/List.hs b/libsrc/MissingH/List.hs
index b5541f5..97c707e 100644
--- a/libsrc/MissingH/List.hs
+++ b/libsrc/MissingH/List.hs
@@ -39,6 +39,9 @@ module MissingH.List(-- * Tests
provide an interface similar to "Data.FiniteMap"
for association lists. -}
addToAL, delFromAL, flipAL,
+ -- ** Association List Conversions
+ strFromAL,
+ strToAL,
-- * Conversions
split, join, replace, genericJoin, takeWhileList,
dropWhileList, spanList, breakList,
@@ -201,6 +204,34 @@ flipAL oldl =
in
worker oldl []
+{- | Converts an association list to a string. The string will have
+one pair per line, with the key and value both represented as a Haskell string.
+
+This function is designed to work with [(String, String)] association lists,
+but may work with other types as well. -}
+
+strFromAL :: (Show a, Show b) => [(a, b)] -> String
+strFromAL inp =
+ let worker (key, val) = show key ++ "," ++ show val
+ in unlines . map worker $ inp
+
+{- | The inverse of 'strFromAL', this function reads a string and outputs the
+appropriate association list.
+
+Like 'strFromAL', this is designed to work with [(String, String)] association
+lists but may also work with other objects with simple representations.
+-}
+strToAL :: (Read a, Read b) => String -> [(a, b)]
+strToAL inp =
+ let worker line =
+ case reads line of
+ [(key, remainder)] -> case remainder of
+ ',':valstr -> (key, read valstr)
+ _ -> error "MissingH.List.strToAL: Parse error on value"
+ _ -> error "MissingH.List.strToAL: Parse error on key"
+ in map worker (lines inp)
+
+
{- FIXME TODO: sub -}
{- | Returns a count of the number of times the given element occured in the
diff --git a/testsrc/Listtest.hs b/testsrc/Listtest.hs
index 743c24a..4f6f575 100644
--- a/testsrc/Listtest.hs
+++ b/testsrc/Listtest.hs
@@ -144,6 +144,21 @@ test_alwaysElemRIndex =
,f 'f' ['f', 'b', 'f', 'f', 'b'] 3
]
+test_strToAL =
+ let f inp exp = TestLabel (show inp) $ TestCase $ do let r = strFromAL inp
+ exp @=? r
+ inp @=? strToAL r
+ in
+ [
+ f ([]::[(String, String)]) ""
+ ,f [("foo", "bar")] "\"foo\",\"bar\"\n"
+ ,f [("foo", "bar"), ("baz", "quux")] "\"foo\",\"bar\"\n\"baz\",\"quux\"\n"
+ ,f [(1::Int, 2::Int), (3, 4)] "1,2\n3,4\n"
+ ,f [(1::Int, "one"), (2, "two")] "1,\"one\"\n2,\"two\"\n"
+ ,f [("one", 1::Double), ("n\nl", 2::Double)]
+ "\"one\",1.0\n\"n\\nl\",2.0\n"
+ ]
+
tests = TestList [TestLabel "delFromAL" (TestList test_delFromAL),
TestLabel "addToAL" (TestList test_addToAL),
TestLabel "split" (TestList test_split),
@@ -154,7 +169,8 @@ tests = TestList [TestLabel "delFromAL" (TestList test_delFromAL),
TestLabel "elemRIndex" (TestList test_elemRIndex),
TestLabel "alwaysElemRIndex" (TestList test_alwaysElemRIndex),
TestLabel "replace" (TestList test_replace),
- TestLabel "contains" (TestList test_contains)]
+ TestLabel "contains" (TestList test_contains),
+ TestLabel "strFromAL & strToAL" (TestList test_strToAL)]
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list