diff --git a/Web/Mime.hs b/Web/Mime.hs new file mode 100644 index 00000000..900daf7c --- /dev/null +++ b/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 diff --git a/Yesod.hs b/Yesod.hs index 8ebda038..574bf690 100644 --- a/Yesod.hs +++ b/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 diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index ca89257d..d2def0c6 100644 --- a/Yesod/Handler.hs +++ b/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 diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index e5e38ecc..e9d2fb72 100644 --- a/Yesod/Helpers/Auth.hs +++ b/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 diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index 61461248..606dfaa0 100644 --- a/Yesod/Helpers/Static.hs +++ b/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 diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs index 509a9f32..7531fbb8 100644 --- a/Yesod/Rep.hs +++ b/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 - ( - ContentType (..) - , Content (..) + ( 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) diff --git a/Yesod/Request.hs b/Yesod/Request.hs index fecaf724..6be3a6f1 100644 --- a/Yesod/Request.hs +++ b/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 (..)) diff --git a/Yesod/Response.hs b/Yesod/Response.hs index b226684e..e3089441 100644 --- a/Yesod/Response.hs +++ b/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 diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 0a5e0d32..85b41f4c 100644 --- a/Yesod/Yesod.hs +++ b/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 diff --git a/yesod.cabal b/yesod.cabal index 57dfd552..bc87bf3a 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -76,6 +76,7 @@ library Yesod.Helpers.Static Yesod.Helpers.AtomFeed Yesod.Helpers.Sitemap + Web.Mime ghc-options: -Wall -Werror executable runtests