[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:44:59 UTC 2010
The following commit has been merged in the master branch:
commit 78026796e3e143068e920d3907deb73c0a8c62a9
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Oct 21 09:32:26 2004 +0100
Added flipAL
Keywords:
(jgoerzen at complete.org--projects/missingh--head--1.0--patch-88)
diff --git a/ChangeLog b/ChangeLog
index 1f50904..5b3cb45 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
#
+2004-10-21 03:32:26 GMT John Goerzen <jgoerzen at complete.org> patch-88
+
+ Summary:
+ Added flipAL
+ Revision:
+ missingh--head--1.0--patch-88
+
+
+ modified files:
+ ChangeLog libsrc/MissingH/List.hs libsrc/MissingH/MIMETypes.hs
+ testsrc/Listtest.hs
+
+
2004-10-20 21:24:05 GMT John Goerzen <jgoerzen at complete.org> patch-87
Summary:
diff --git a/libsrc/MissingH/List.hs b/libsrc/MissingH/List.hs
index e673e37..025cbb2 100644
--- a/libsrc/MissingH/List.hs
+++ b/libsrc/MissingH/List.hs
@@ -38,7 +38,7 @@ module MissingH.List(-- * Tests
association list functions in "Data.List" and
provide an interface similar to "Data.FiniteMap"
for association lists. -}
- addToAL, delFromAL,
+ addToAL, delFromAL, flipAL,
-- * Conversions
split, join, genericJoin, trunc,
-- * Miscellaneous
@@ -159,6 +159,19 @@ matches the given one. -}
delFromAL :: Eq key => [(key, a)] -> key -> [(key, a)]
delFromAL l key = filter (\a -> (fst a) /= key) l
+{- Flips an association list. Converts (key1, val), (key2, val) pairs
+to (val, [key1, key2]). -}
+flipAL :: (Eq key, Eq val) => [(key, val)] -> [(val, [key])]
+flipAL oldl =
+ let worker :: (Eq key, Eq val) => [(key, val)] -> [(val, [key])] -> [(val, [key])]
+ worker [] accum = accum
+ worker ((k, v):xs) accum =
+ case lookup v accum of
+ Nothing -> worker xs ((v, [k]) : accum)
+ Just y -> worker xs (addToAL accum v (k:y))
+ in
+ worker oldl []
+
{- FIXME TODO: sub -}
{- | Returns a count of the number of times the given element occured in the
diff --git a/libsrc/MissingH/MIMETypes.hs b/libsrc/MissingH/MIMETypes.hs
index c7f2ab7..122f4f3 100644
--- a/libsrc/MissingH/MIMETypes.hs
+++ b/libsrc/MissingH/MIMETypes.hs
@@ -32,19 +32,22 @@ Written by John Goerzen, jgoerzen\@complete.org
-}
module MissingH.MIMETypes (-- * Creating Lookup Objects
- newMIMETypes,
+ defaultMIMETypeData,
+ readMIMETypes,
+ hReadMIMETypes,
readSystemMIMETypes,
-- * Basic Access
MIMEResults,
- MIMETypeFunctions(..),
- -- * Advanced Usage
MIMETypeData(..),
- makeMIMETypes,
+ guessType,
+ guessExtension,
+
)
where
import Data.FiniteMap
import qualified System.Directory
+import Monad
import System.IO
import System.IO.Error
import MissingH.IO
@@ -81,36 +84,78 @@ type MIMEResults = (Maybe String, -- The MIME type
Maybe String -- Encoding
)
-data MIMETypeFunctions = MIMETypeFunctions
- {
- {- | Read the given mime.types file. The first argument is whether or not to add to the strict table. -}
- readMimeTypes :: Bool -> FilePath -> IO MIMETypeFunctions,
- {- | Load a mime.types file from an already-open handle.
- The first argument is whether or not to add to the strict table. -}
- hReadMimeTypes :: Bool -> Handle -> IO MIMETypeFunctions,
- {- | Guess the type of a file given a filename or URL. The file
- is not opened; only the name is considered.
-
- The first argument says whether or not to use strict mode. The second
- gives the filename or URL.-}
- guessType :: Bool -> String -> MIMEResults,
- {- | Guess the extension of a file based on its MIME type.
- The return value includes the leading dot. The first parameter
- is whether or not to use strict mode; the second is the MIME type.
- Returns Nothing if no extension could be found. -}
- guessExtension :: Bool -> String -> Maybe String,
- {- | Adds a new type to the data structures, replacing whatever data
- may exist about it already. The first parameter denotes whether
- or not to add to the strict structures. The second gives the MIME type,
- and the third gives the extension. -}
- addType :: Bool -> String -> String -> MIMETypeFunctions,
- {- | Advanced users: returns the internal 'MIMETypeData'. -}
- getMIMETypeData :: MIMETypeData,
- {- | Advanced users: sets the internal 'MIMETypeData',
- returning a new object with it. -}
- setMIMETypeData :: MIMETypeData -> MIMETypeFunctions
- }
+{- | Read the given mime.types file and add it to an existing object.
+Returns new object. -}
+
+
+readMIMETypes :: MIMETypeData -- ^ Data to work with
+ -> Bool -- ^ Whether to work on strict data
+ -> FilePath -- ^ File to read
+ -> IO MIMETypeData -- ^ New object
+readMIMETypes mtd strict fn = do
+ h <- openFile fn ReadMode
+ retval <- hReadMIMETypes mtd strict h
+ hClose h
+ return retval
+
+{- | Load a mime.types file from an already-open handle. -}
+hReadMIMETypes :: MIMETypeData -- ^ Data to work with
+ -> Bool -- ^ Whether to work on strict data
+ -> Handle -- ^ Handle to read from
+ -> IO MIMETypeData -- ^ New object
+hReadMIMETypes mtd strict h =
+ let parseline :: MIMETypeData -> String -> MIMETypeData
+ parseline obj line =
+ let l1 = words line
+ procwords [] = []
+ procwords (('#':_) :_) = []
+ procwords (x:xs) = x : procwords xs
+ l2 = procwords l1
+ in
+ if (length l2) >= 2 then
+ let thetype = head l2
+ suffixlist = tail l2
+ in
+ foldl (\o suff -> addType o strict thetype suff) obj suffixlist
+ else obj
+ in
+ do
+ lines <- hGetLines h
+ return (foldl parseline mtd lines)
+
+{- | Guess the type of a file given a filename or URL. The file
+ is not opened; only the name is considered. -}
+
+guessType :: MIMETypeData -- ^ Source data for guessing
+ -> Bool -- ^ Whether to limit to strict data
+ -> String -- ^ File or URL name to consider
+ -> MIMEResults -- ^ Result of guessing (see 'MIMEResults' for details on interpreting it)
+-- FIXME
+guessType mtd strict fn = (Nothing, Nothing)
+
+{- | Guess the extension of a file based on its MIME type.
+ The return value includes the leading dot.
+
+ Returns Nothing if no extension could be found. -}
+guessExtension :: MIMETypeData -- ^ Source data for guessing
+ -> Bool -- ^ Whether to limit to strict data
+ -> String -- ^ File or URL name to consider
+ -> Maybe String -- ^ Result of guessing, or Nothing if no match possible
+-- FIXME
+guessExtension mtd strict fn = Nothing
+{- | Adds a new type to the data structures, replacing whatever data
+ may exist about it already. -}
+
+addType :: MIMETypeData -- ^ Source data
+ -> Bool -- ^ Whether to add to strict data set
+ -> String -- ^ MIME type to add
+ -> String -- ^ Extension to add
+ -> MIMETypeData -- ^ Result of addition
+-- FIXME
+addType mtd strict thetype theext = mtd
+
+{- | Default MIME type data to use -}
defaultMIMETypeData :: MIMETypeData
defaultMIMETypeData =
MIMETypeData {suffixMap = default_suffix_map,
@@ -118,81 +163,35 @@ defaultMIMETypeData =
typesMap = default_types_map,
commonTypesMap = default_common_types}
-{- | Create a new MIME type lookup object. This is the main entry
-into the library. -}
-newMIMETypes :: MIMETypeFunctions
-newMIMETypes = makeMIMETypes defaultMIMETypeData
-
-{- | Create a new MIME type lookup object based on the given
-'MIMETypeData' object. -}
-makeMIMETypes :: MIMETypeData -> MIMETypeFunctions
-makeMIMETypes mtd =
- let self = makeMIMETypes mtd in
- -- FIXME
- let hrmt strict h =
- let parseline :: MIMETypeFunctions -> String -> MIMETypeFunctions
- parseline obj line =
- let l1 = words line
- procwords [] = []
- procwords (('#':_) :_) = []
- procwords (x:xs) = x : procwords xs
- l2 = procwords l1
- in
- if (length l2) >= 2 then
- let thetype = head l2
- suffixlist = tail l2
- in
- foldl (\o suff -> (addType o) strict thetype suff) obj suffixlist
- else self
- in
- do
- lines <- hGetLines h
- return (foldl parseline self lines)
-
- in
- MIMETypeFunctions
- {
- readMimeTypes = (\strict fn -> (do
- h <- openFile fn ReadMode
- retval <- hrmt strict h
- hClose h
- return retval
- )
- ),
- hReadMimeTypes = hrmt,
- -- FIXME
- guessType = \strict thefile -> (Nothing, Nothing),
- -- FIXME
- guessExtension = \strict thetype -> Nothing,
- -- FIXME
- addType = \strict thetype theext -> makeMIMETypes mtd,
- getMIMETypeData = mtd,
- setMIMETypeData = \newmtd -> makeMIMETypes newmtd
- }
-
-
{- | Read the system's default mime.types files, and add the data contained
therein to the passed object, then return the new one. -}
-readSystemMIMETypes :: MIMETypeFunctions -> IO MIMETypeFunctions
-readSystemMIMETypes mtf =
- let tryread :: IO MIMETypeFunctions -> String -> IO MIMETypeFunctions
- tryread inputio filename =
+readSystemMIMETypes :: MIMETypeData -> IO MIMETypeData
+readSystemMIMETypes mtd =
+ let tryread :: MIMETypeData -> String -> IO MIMETypeData
+ tryread inputobj filename =
do
- inputobj <- inputio
fn <- try (openFile filename ReadMode)
case fn of
Left _ -> return inputobj
Right h -> do
- x <- (hReadMimeTypes inputobj) True h
+ x <- hReadMIMETypes inputobj True h
hClose h
return x
in
do
- foldl tryread (return mtf) defaultfilelocations
+ foldM tryread mtd defaultfilelocations
-{- | Advanced users: create a new MIME type lookup object based on a
-'MIMETypeData' object.
--}
+----------------------------------------------------------------------
+-- Internal utilities
+----------------------------------------------------------------------
+
+getStrict :: MIMETypeData -> Bool -> FiniteMap String String
+getStrict mtd True = typesMap mtd
+getStrict mtd False = plusFM (commonTypesMap mtd) (typesMap mtd)
+
+setStrict :: MIMETypeData -> Bool -> (FiniteMap String String -> FiniteMap String String) -> MIMETypeData
+setStrict mtd True func = mtd{typesMap = func (typesMap mtd)}
+setStrict mtd False func = mtd{commonTypesMap = func (commonTypesMap mtd)}
----------------------------------------------------------------------
-- Default data structures
diff --git a/testsrc/Listtest.hs b/testsrc/Listtest.hs
index 424eb16..35a50b1 100644
--- a/testsrc/Listtest.hs
+++ b/testsrc/Listtest.hs
@@ -66,6 +66,17 @@ test_genericJoin =
f "|" ["foo", "bar", "baz"] "\"foo\"|\"bar\"|\"baz\""
f ", " [5] "5"
+test_flipAL =
+ let f inp exp = exp @=? flipAL inp in
+ do
+ f ([]::[(Int,Int)]) ([]::[(Int,[Int])])
+ f [("a", "b")] [("b", ["a"])]
+ f [("a", "b"),
+ ("c", "b"),
+ ("d", "e"),
+ ("b", "b")] [("b", ["a", "c", "d"]),
+ ("e", ["d"])]
+
test_trunc =
let f len inp exp = exp @=? trunc len inp in
do
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list