Factored mime-type code into its own module

Web/Mime.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+-- | Generic MIME type module. Could be spun off into its own package.
+module Web.Mime
+    ( ContentType (..)
+    , typeByExt
+    , ext
+    ) where
+
+import Data.Function (on)
+import Data.Convertible.Text
+
+data ContentType =
+    TypeHtml
+    | TypePlain
+    | TypeJson
+    | TypeXml
+    | TypeAtom
+    | TypeJpeg
+    | TypePng
+    | TypeGif
+    | TypeJavascript
+    | TypeCss
+    | TypeFlv
+    | TypeOgv
+    | TypeOctet
+    | TypeOther String
+    deriving (Show)
+
+instance ConvertSuccess ContentType [Char] where
+    convertSuccess TypeHtml = "text/html; charset=utf-8"
+    convertSuccess TypePlain = "text/plain; charset=utf-8"
+    convertSuccess TypeJson = "application/json; charset=utf-8"
+    convertSuccess TypeXml = "text/xml"
+    convertSuccess TypeAtom = "application/atom+xml"
+    convertSuccess TypeJpeg = "image/jpeg"
+    convertSuccess TypePng = "image/png"
+    convertSuccess TypeGif = "image/gif"
+    convertSuccess TypeJavascript = "text/javascript; charset=utf-8"
+    convertSuccess TypeCss = "text/css; charset=utf-8"
+    convertSuccess TypeFlv = "video/x-flv"
+    convertSuccess TypeOgv = "video/ogg"
+    convertSuccess TypeOctet = "application/octet-stream"
+    convertSuccess (TypeOther s) = s
+
+instance Eq ContentType where
+    (==) = (==) `on` (cs :: ContentType -> String)
+
+-- | Determine a mime-type based on the file extension.
+typeByExt :: String -> ContentType
+typeByExt "jpg" = TypeJpeg
+typeByExt "jpeg" = TypeJpeg
+typeByExt "js" = TypeJavascript
+typeByExt "css" = TypeCss
+typeByExt "html" = TypeHtml
+typeByExt "png" = TypePng
+typeByExt "gif" = TypeGif
+typeByExt "txt" = TypePlain
+typeByExt "flv" = TypeFlv
+typeByExt "ogv" = TypeOgv
+typeByExt _ = TypeOctet
+
+-- | Get a file extension (everything after last period).
+ext :: String -> String
+ext = reverse . fst . break (== '.') . reverse

Yesod.hs

@@ -24,6 +24,7 @@ module Yesod
     , module Yesod.Parameter
     , module Yesod.Rep
     , module Yesod.Template
+    , module Web.Mime
     , Application
     ) where
 
@@ -47,3 +48,4 @@ import Yesod.Definitions
 import Yesod.Handler
 import Hack (Application)
 import Yesod.Template
+import Web.Mime

Yesod/Handler.hs

@@ -39,6 +39,7 @@ import Yesod.Request
 import Yesod.Response
 import Yesod.Rep
 import Yesod.Template
+import Web.Mime
 
 import Control.Exception hiding (Handler)
 import Control.Applicative

Yesod/Helpers/Auth.hs

@@ -129,7 +129,7 @@ authOpenidComplete = do
 rpxnowLogin :: YesodAuth y => Handler y HtmlObject
 rpxnowLogin = do
     ay <- getYesod
-    let (Approot ar) = approot ay
+    let ar = approot ay
     apiKey <- case rpxnowApiKey ay of
                 Just x -> return x
                 Nothing -> notFound

Yesod/Helpers/Static.hs

@@ -58,24 +58,8 @@ getStatic fl fp' = do
     content <- liftIO $ fl fp
     case content of
         Nothing -> notFound
-        Just bs -> return [(mimeType $ ext fp, Content bs)]
+        Just bs -> return [(typeByExt $ ext fp, Content bs)]
       where
         isUnsafe [] = True
         isUnsafe ('.':_) = True
         isUnsafe _ = False
-
-mimeType :: String -> ContentType
-mimeType "jpg" = TypeJpeg
-mimeType "jpeg" = TypeJpeg
-mimeType "js" = TypeJavascript
-mimeType "css" = TypeCss
-mimeType "html" = TypeHtml
-mimeType "png" = TypePng
-mimeType "gif" = TypeGif
-mimeType "txt" = TypePlain
-mimeType "flv" = TypeFlv
-mimeType "ogv" = TypeOgv
-mimeType _ = TypeOctet
-
-ext :: String -> String
-ext = reverse . fst . break (== '.') . reverse

Yesod/Rep.hs

@@ -26,9 +26,7 @@
 -- all data can be contained in an 'Object'; however, some of it requires more
 -- effort.
 module Yesod.Rep
-    (
+    ( Content (..)
-      ContentType (..)
-    , Content (..)
     , RepChooser
     , ContentPair
     , HasReps (..)
@@ -48,7 +46,7 @@ import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as BL
 import Data.Text.Lazy (Text)
 import Data.Maybe (mapMaybe)
-import Data.Function (on)
+import Web.Mime
 
 #if TEST
 import Data.Object.Html hiding (testSuite)
@@ -65,40 +63,6 @@ import Test.Framework.Providers.HUnit
 import Test.HUnit hiding (Test)
 #endif
 
-data ContentType =
-    TypeHtml
-    | TypePlain
-    | TypeJson
-    | TypeXml
-    | TypeAtom
-    | TypeJpeg
-    | TypePng
-    | TypeGif
-    | TypeJavascript
-    | TypeCss
-    | TypeFlv
-    | TypeOgv
-    | TypeOctet
-    | TypeOther String
-    deriving (Show)
-instance ConvertSuccess ContentType String where
-    convertSuccess TypeHtml = "text/html"
-    convertSuccess TypePlain = "text/plain"
-    convertSuccess TypeJson = "application/json"
-    convertSuccess TypeXml = "text/xml"
-    convertSuccess TypeAtom = "application/atom+xml"
-    convertSuccess TypeJpeg = "image/jpeg"
-    convertSuccess TypePng = "image/png"
-    convertSuccess TypeGif = "image/gif"
-    convertSuccess TypeJavascript = "text/javascript"
-    convertSuccess TypeCss = "text/css"
-    convertSuccess TypeFlv = "video/x-flv"
-    convertSuccess TypeOgv = "video/ogg"
-    convertSuccess TypeOctet = "application/octet-stream"
-    convertSuccess (TypeOther s) = s
-instance Eq ContentType where
-    (==) = (==) `on` (cs :: ContentType -> String)
-
 newtype Content = Content { unContent :: ByteString }
     deriving (Eq, Show)
 

Yesod/Request.hs

@@ -46,7 +46,7 @@ module Yesod.Request
 import qualified Hack
 import Data.Function.Predicate (equals)
 import Yesod.Constants
-import Yesod.Utils (tryLookup, parseHttpAccept)
+import Yesod.Utils (tryLookup)
 import Yesod.Definitions
 import Yesod.Parameter
 import Control.Applicative (Applicative (..))

Yesod/Response.hs

@@ -52,6 +52,7 @@ import Test.Framework (testGroup, Test)
 import Data.Generics
 import Control.Exception (Exception)
 import Data.Convertible.Text (cs)
+import Web.Mime
 
 data Response = Response Int [Header] ContentType Content
     deriving Show

Yesod/Yesod.hs

@@ -19,6 +19,7 @@ import Yesod.Template (TemplateGroup)
 import Data.Maybe (fromMaybe)
 import Data.Convertible.Text
 import Text.StringTemplate
+import Web.Mime
 
 import qualified Hack
 import Hack.Middleware.CleanPath

yesod.cabal

@@ -76,6 +76,7 @@ library
                      Yesod.Helpers.Static
                      Yesod.Helpers.AtomFeed
                      Yesod.Helpers.Sitemap
+                     Web.Mime
     ghc-options:     -Wall -Werror
 
 executable             runtests