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

    Wrote guessAllExtensions
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--1.0--patch-94)

diff --git a/ChangeLog b/ChangeLog
index 9d24959..9c8fd82 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 17:30:34 GMT	John Goerzen <jgoerzen at complete.org>	patch-94
+
+    Summary:
+      Wrote guessAllExtensions
+    Revision:
+      missingh--head--1.0--patch-94
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/MIMETypes.hs
+     testsrc/MIMETypestest.hs
+
+
 2004-10-21 17:15:45 GMT	John Goerzen <jgoerzen at complete.org>	patch-93
 
     Summary:
diff --git a/libsrc/MissingH/MIMETypes.hs b/libsrc/MissingH/MIMETypes.hs
index a92ea30..0cce161 100644
--- a/libsrc/MissingH/MIMETypes.hs
+++ b/libsrc/MissingH/MIMETypes.hs
@@ -41,7 +41,7 @@ module MissingH.MIMETypes (-- * Creating Lookup Objects
                            MIMETypeData(..),
                            guessType,
                            guessExtension,
-
+                           guessAllExtensions
                           )
 where
 
@@ -52,6 +52,7 @@ import System.IO
 import System.IO.Error
 import MissingH.IO
 import MissingH.Path
+import MissingH.FiniteMap
 import Data.Char
 
 ----------------------------------------------------------------------
@@ -156,11 +157,25 @@ guessType mtd strict fn =
    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
+                  -> String             -- ^ MIME type to consider
                   -> Maybe String       -- ^ Result of guessing, or Nothing if no match possible
--- FIXME
-guessExtension mtd strict fn = Nothing
-
+guessExtension mtd strict fn = 
+    case guessAllExtensions mtd strict fn of
+                                          [] -> Nothing
+                                          (x:_) -> Just x
+
+{- | Similar to 'guessExtension', but returns a list of all possible matching
+extensions, or the empty list if there are no matches. -}
+guessAllExtensions :: MIMETypeData      -- ^ Source data for guessing
+                      -> Bool           -- ^ Whether to limit to strict data
+                      -> String         -- ^ MIME type to consider
+                      -> [String]       -- ^ Result of guessing
+guessAllExtensions mtd strict fn =
+    let mimetype = map toLower fn
+        themap = getStrict mtd strict
+        in
+        flippedLookupFM themap mimetype
+        
 {- | Adds a new type to the data structures, replacing whatever data
    may exist about it already. -}
 
diff --git a/testsrc/MIMETypestest.hs b/testsrc/MIMETypestest.hs
index 753df75..624140c 100644
--- a/testsrc/MIMETypestest.hs
+++ b/testsrc/MIMETypestest.hs
@@ -18,8 +18,19 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 module MIMETypestest(tests) where
 import HUnit
+import Data.List
 import MissingH.MIMETypes
 
+test_guessAllExtensions =
+    let f strict inp exp = (sort exp) @=? sort (guessAllExtensions defaultmtd strict inp) in
+        do
+        f True "" []
+        f True "foo" []
+        f True "application/octet-stream" [".obj", ".so", ".bin", ".a", ".dll", ".exe", ".o"]
+        f True "text/plain" [".pl", ".ksh", ".bat", ".c", ".h", ".txt"]
+        f True "application/rtf" []
+        f False "application/rtf" [".rtf"]
+
 test_guessType =
     let f strict inp exp = exp @=? guessType defaultmtd strict inp in 
         do
@@ -36,5 +47,6 @@ test_guessType =
         f True "foo.pict" (Nothing, Nothing)
         f False "foo.pict" (Just "image/pict", Nothing)
 
-tests = TestList [TestLabel "guessType" (TestCase test_guessType)
+tests = TestList [TestLabel "guessType" (TestCase test_guessType),
+                  TestLabel "guessAllExtensions" (TestCase test_guessAllExtensions)
                  ]
\ No newline at end of file

-- 
haskell-testpack