[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 e2bfa146c229869833996e77d67d38c4efb36acd
Author: John Goerzen <jgoerzen at complete.org>
Date:   Thu Oct 21 23:55:21 2004 +0100

    Fixed readMIMETypes -- it now works
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-95)

diff --git a/ChangeLog b/ChangeLog
index 9c8fd82..96607a0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,22 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--1.0
 #
 
+2004-10-21 17:55:21 GMT	John Goerzen <jgoerzen at complete.org>	patch-95
+
+    Summary:
+      Fixed readMIMETypes -- it now works
+    Revision:
+      missingh--head--1.0--patch-95
+
+
+    new files:
+     testsrc/mime.types.test
+
+    modified files:
+     ChangeLog libsrc/MissingH/MIMETypes.hs
+     testsrc/MIMETypestest.hs
+
+
 2004-10-21 17:30:34 GMT	John Goerzen <jgoerzen at complete.org>	patch-94
 
     Summary:
diff --git a/libsrc/MissingH/MIMETypes.hs b/libsrc/MissingH/MIMETypes.hs
index 0cce161..4f57fe0 100644
--- a/libsrc/MissingH/MIMETypes.hs
+++ b/libsrc/MissingH/MIMETypes.hs
@@ -98,7 +98,6 @@ readMIMETypes :: MIMETypeData            -- ^ Data to work with
 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. -}
@@ -119,7 +118,7 @@ hReadMIMETypes mtd strict h =
                    let thetype = head l2
                        suffixlist = tail l2
                        in
-                       foldl (\o suff -> addType o strict thetype suff) obj suffixlist
+                       foldl (\o suff -> addType o strict thetype ('.' : suff)) obj suffixlist
                 else obj
         in
         do
@@ -154,7 +153,11 @@ guessType mtd strict fn =
 {- | 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. -}
+   Returns Nothing if no extension could be found.
+
+   In the event that multiple possible extensions are available,
+   one of them will be picked and returned.  The logic to select one
+   of these should be considered undefined. -}
 guessExtension :: MIMETypeData          -- ^ Source data for guessing
                   -> Bool               -- ^ Whether to limit to strict data
                   -> String             -- ^ MIME type to consider
@@ -177,15 +180,16 @@ guessAllExtensions mtd strict fn =
         flippedLookupFM themap mimetype
         
 {- | Adds a new type to the data structures, replacing whatever data
-   may exist about it already. -}
+   may exist about it already.  That is, it overrides existing information
+   about the given extension, but the same type may occur more than once. -}
 
 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
+addType mtd strict thetype theext = 
+    setStrict mtd strict (\m -> addToFM m theext thetype)
 
 {- | Default MIME type data to use -}
 defaultmtd :: MIMETypeData
diff --git a/testsrc/MIMETypestest.hs b/testsrc/MIMETypestest.hs
index 624140c..5a91752 100644
--- a/testsrc/MIMETypestest.hs
+++ b/testsrc/MIMETypestest.hs
@@ -21,6 +21,23 @@ import HUnit
 import Data.List
 import MissingH.MIMETypes
 
+test_readMIMETypes =
+    do
+    mtd <- readMIMETypes defaultmtd True "testsrc/mime.types.test"
+    putStrLn "\nread\n"
+    let f = \strict inp exp -> exp @=? guessType mtd strict inp
+    let fe = \strict inp exp -> (sort exp) @=? sort (guessAllExtensions mtd strict inp)
+    f True "foo.bar.baz" (Nothing, Nothing)
+    f True "" (Nothing, Nothing)
+    f True "foo.ez" (Just "application/andrew-inset", Nothing)
+    fe True "application/andrew-inset" [".ez"]
+    f True "foo.dv" (Just "video/x-dv", Nothing)
+    fe True "video/x-dv" [".dif", ".dv"]
+    f True "test.h++" (Just "text/x-c++hdr", Nothing)
+    fe True "text/x-c++hdr" [".h++", ".hpp", ".hxx", ".hh"]
+    f True "foo.tgz" (Just "application/x-tar", Just "gzip")
+
+
 test_guessAllExtensions =
     let f strict inp exp = (sort exp) @=? sort (guessAllExtensions defaultmtd strict inp) in
         do
@@ -48,5 +65,6 @@ test_guessType =
         f False "foo.pict" (Just "image/pict", Nothing)
 
 tests = TestList [TestLabel "guessType" (TestCase test_guessType),
-                  TestLabel "guessAllExtensions" (TestCase test_guessAllExtensions)
+                  TestLabel "guessAllExtensions" (TestCase test_guessAllExtensions),
+                  TestLabel "readMIMETypes" (TestCase test_readMIMETypes)
                  ]
\ No newline at end of file
diff --git a/testsrc/mime.types.test b/testsrc/mime.types.test
new file mode 100644
index 0000000..0577a55
--- /dev/null
+++ b/testsrc/mime.types.test
@@ -0,0 +1,24 @@
+# arch-tag: test file for MIMETypes
+# Here are some comments
+#
+##
+
+# and some fun blank lines
+
+     
+
+# Some types with nothing
+
+application/activemessage
+application/applefile   
+application/atomicmail         # comment here
+
+# Some lines with real stuff
+
+application/andrew-inset       ez     # blah
+
+# Some lines with multiple things
+
+video/x-dv                                      dif dv
+text/x-c++hdr                                   h++ hpp hxx hh # foo
+

-- 
haskell-testpack